pgplot/fonts/pgdchar.f010064400040640000322000000047740536760042700154670ustar00tjpcitmbr00000400000017 PROGRAM DCHAR C---------------------------------------------------------------------- C Display construction of Hershey character. C This program uses the PGPLOT internal routine GRSYXD and must C therefore be linked with the non-shareable library. C T. J. Pearson 1983 Feb 12 C---------------------------------------------------------------------- INTEGER PGBEG, HEIGHT, DEPTH, WIDTH INTEGER XYGRID(300),I,N,M REAL XC,YC,X(5),BASE LOGICAL UNUSED,MOVE CHARACTER*4 TEXT C----------------------------------------------------------------------- IF (PGBEG(0,'?',1,1).NE.1) STOP CALL PGASK(.FALSE.) 20 WRITE (*,'(A,$)') ' Symbol number: ' M = N READ (*,*,END=30) N IF (N.EQ.0) N = M+1 CALL GRSYXD(N,XYGRID,UNUSED) IF (UNUSED) THEN WRITE (*,'(A)') ' Symbol not defined' GOTO 20 END IF C C Call PGENV to initialize the viewport and window; the C AXIS argument is -2, so no frame or labels will be drawn. C CALL PGBBUF CALL PGENV(-50.,50.,-50.,50.0,1,-2) C C Call PGBOX to draw a grid at low brightness. C CALL PGSCI(15) CALL PGSLW(1) CALL PGBOX('G',10.0,0,'G',10.0,0) CALL PGSCI(5) C DO 15 I=1,5 X(I) = XYGRID(I) 15 CONTINUE C C Shift coordinates so baseline is y=0; center is (0,-BASE) C BASE = X(2) X(1) = X(1)-BASE X(3) = X(3)-BASE HEIGHT=X(3) DEPTH = X(1) WIDTH =X(5)-X(4) WRITE(*,*) N, HEIGHT, DEPTH, WIDTH C C Draw the `bounding box'. C CALL PGMOVE(X(4),X(1)) CALL PGDRAW(X(5),X(1)) CALL PGDRAW(X(5),X(3)) CALL PGDRAW(X(4),X(3)) CALL PGDRAW(X(4),X(1)) C C Draw the baseline. C CALL PGMOVE(-50.0, 0.0) CALL PGDRAW(50.0, 0.0) C C Mark the `center' of the character. C CALL PGPT(1, 0.0, -BASE, 9) C C Write the Hershey number in lower left corner. C WRITE (TEXT,'(I4)') N CALL PGTEXT(-49.0, -49.0, TEXT) C CALL PGSCI(3) CALL PGSLW(3) I = 6 MOVE = .TRUE. 26 XC = XYGRID(I) I = I+1 IF (XYGRID(I).EQ.-64) THEN CALL PGEBUF GOTO 20 END IF YC = XYGRID(I)-BASE I = I+1 IF (XYGRID(I-2).EQ.-64) THEN MOVE = .TRUE. GOTO 26 END IF IF (MOVE) THEN CALL PGMOVE(XC,YC) MOVE = .FALSE. ELSE CALL PGDRAW(XC,YC) END IF GOTO 26 C C Don't forget to call PGEND! C 30 CALL PGEND END pgplot/fonts/pgunpack.f010064400040640000322000000027050444326231600156520ustar00tjpcitmbr00000400000017 PROGRAM UNPACK C---------------------------------------------------------------------- C Convert packed (binary) representation of GRFONT into unpacked C (ASCII) representation suitable for editing. The input file is C read from PLT$FONT as in PGPLOT; the output file is GRFONT.TXT. C C This program uses the PGPLOT internal routines GRSY00 and C GRSYXD and must therefore be linked with the non-shareable library. C C T. J. Pearson 1987 May 6 C---------------------------------------------------------------------- INTEGER XYGRID(300) LOGICAL UNUSED INTEGER I, N, LENGTH C----------------------------------------------------------------------- OPEN (UNIT=1, FILE='grfont.txt', STATUS='NEW', 1 CARRIAGECONTROL='LIST') CALL GRSY00 DO 30 N=1,4000 CALL GRSYXD(N,XYGRID,UNUSED) IF (.NOT.UNUSED) THEN c DO 10 I=1,300 do 10 i=2,300,2 IF(XYGRID(I).EQ.-64) THEN IF (XYGRID(I+1).EQ.-64) THEN LENGTH = I+1 GOTO 20 END IF END IF 10 CONTINUE STOP 'Unfortunate error' 20 WRITE (1,'(7(2X,2I4))') N, LENGTH, (XYGRID(I), I=1,5) WRITE (1,'(7(2X,2I4))') (XYGRID(I),I=6,LENGTH) END IF 30 CONTINUE C----------------------------------------------------------------------- END pgplot/fonts/grfont.txt010064400040640000322000021005740434443575200157460ustar00tjpcitmbr00000400000017 1 23 -4 -4 5 -5 5 0 5 -4 -4 -64 0 0 5 4 -4 -64 0 -2 -1 2 -1 -64 -64 2 37 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 1 5 3 4 3 2 1 1 -64 0 -3 1 1 1 3 0 3 -3 1 -4 -3 -4 -64 -64 3 27 -4 -4 5 -5 6 4 4 2 5 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 2 -4 4 -3 -64 -64 4 29 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 0 5 2 4 3 2 3 -1 2 -3 0 -4 -3 -4 -64 -64 5 29 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 3 5 -64 0 -3 1 1 1 -64 0 -3 -4 3 -4 -64 -64 6 23 -4 -4 5 -5 4 -3 5 -3 -4 -64 0 -3 5 3 5 -64 0 -3 1 1 1 -64 -64 7 35 -4 -4 5 -5 6 4 4 2 5 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 2 -4 4 -3 4 0 -64 0 1 0 4 0 -64 -64 8 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 3 5 3 -4 -64 0 -3 1 3 1 -64 -64 9 11 -4 -4 5 -2 2 0 5 0 -4 -64 -64 10 19 -4 -4 5 -4 3 1 5 1 -2 0 -4 -2 -4 -3 -2 -3 -1 -64 -64 11 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 3 5 -3 -1 -64 0 -1 1 3 -4 -64 -64 12 17 -4 -4 5 -5 4 -3 5 -3 -4 -64 0 -3 -4 3 -4 -64 -64 13 29 -4 -4 5 -6 6 -4 5 -4 -4 -64 0 -4 5 0 -4 -64 0 4 5 0 -4 -64 0 4 5 4 -4 -64 -64 14 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 3 -4 -64 0 3 5 3 -4 -64 -64 15 33 -4 -4 5 -5 6 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 1 -4 3 -3 4 -1 4 2 3 4 1 5 0 5 -64 -64 16 25 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 1 5 3 4 3 1 1 0 -3 0 -64 -64 17 39 -4 -4 5 -5 6 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 1 -4 3 -3 4 -1 4 2 3 4 1 5 0 5 -64 0 1 -2 4 -5 -64 -64 18 31 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 1 5 3 4 3 1 1 0 -3 0 -64 0 0 0 3 -4 -64 -64 19 31 -4 -4 5 -5 5 3 4 1 5 -1 5 -3 4 -3 3 -2 2 2 0 3 -1 3 -3 1 -4 -1 -4 -3 -3 -64 -64 20 17 -4 -4 5 -5 5 0 5 0 -4 -64 0 -4 5 4 5 -64 -64 21 23 -4 -4 5 -5 6 -3 5 -3 -1 -2 -3 0 -4 1 -4 3 -3 4 -1 4 5 -64 -64 22 17 -4 -4 5 -5 5 -4 5 0 -4 -64 0 4 5 0 -4 -64 -64 23 29 -4 -4 5 -6 6 -4 5 -2 -4 -64 0 0 5 -2 -4 -64 0 0 5 2 -4 -64 0 4 5 2 -4 -64 -64 24 17 -4 -4 5 -5 5 -3 5 3 -4 -64 0 3 5 -3 -4 -64 -64 25 19 -4 -4 5 -5 5 -4 5 0 1 0 -4 -64 0 4 5 0 1 -64 -64 26 23 -4 -4 5 -5 5 3 5 -3 -4 -64 0 -3 5 3 5 -64 0 -3 -4 3 -4 -64 -64 27 23 -4 -4 5 -5 5 0 5 -4 -4 -64 0 0 5 4 -4 -64 0 -2 -1 2 -1 -64 -64 28 37 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 1 5 3 4 3 2 1 1 -64 0 -3 1 1 1 3 0 3 -3 1 -4 -3 -4 -64 -64 29 17 -4 -4 5 -5 4 -3 5 -3 -4 -64 0 -3 5 3 5 -64 -64 30 23 -4 -4 5 -5 5 0 5 -4 -4 -64 0 0 5 4 -4 -64 0 -4 -4 4 -4 -64 -64 31 29 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 3 5 -64 0 -3 1 1 1 -64 0 -3 -4 3 -4 -64 -64 32 23 -4 -4 5 -5 5 3 5 -3 -4 -64 0 -3 5 3 5 -64 0 -3 -4 3 -4 -64 -64 33 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 3 5 3 -4 -64 0 -3 1 3 1 -64 -64 34 45 -4 -4 5 -5 6 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 1 -4 3 -3 4 -1 4 2 3 4 1 5 0 5 -64 0 -1 1 2 0 -64 0 2 1 -1 0 -64 -64 35 11 -4 -4 5 -2 2 0 5 0 -4 -64 -64 36 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 3 5 -3 -1 -64 0 -1 1 3 -4 -64 -64 37 17 -4 -4 5 -5 5 0 5 -4 -4 -64 0 0 5 4 -4 -64 -64 38 29 -4 -4 5 -6 6 -4 5 -4 -4 -64 0 -4 5 0 -4 -64 0 4 5 0 -4 -64 0 4 5 4 -4 -64 -64 39 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 3 -4 -64 0 3 5 3 -4 -64 -64 40 29 -4 -4 5 -5 5 -3 5 3 5 -64 0 -2 1 2 0 -64 0 2 1 -2 0 -64 0 -3 -4 3 -4 -64 -64 41 33 -4 -4 5 -5 6 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 1 -4 3 -3 4 -1 4 2 3 4 1 5 0 5 -64 -64 42 23 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 3 5 3 -4 -64 0 -3 5 3 5 -64 -64 43 25 -4 -4 5 -5 5 -3 5 -3 -4 -64 0 -3 5 1 5 3 4 3 1 1 0 -3 0 -64 -64 44 25 -4 -4 5 -5 5 -3 5 0 1 -3 -4 -64 0 -3 5 3 5 -64 0 -3 -4 3 -4 -64 -64 45 17 -4 -4 5 -5 5 0 5 0 -4 -64 0 -4 5 4 5 -64 -64 46 35 -4 -4 5 -5 5 -4 3 -4 4 -3 5 -2 5 -1 4 0 2 0 -4 -64 0 4 3 4 4 3 5 2 5 1 4 0 2 -64 -64 47 31 -4 -4 5 -6 6 0 5 0 -4 -64 0 -2 3 -4 2 -4 -1 -2 -2 2 -2 4 -1 4 2 2 3 -2 3 -64 -64 48 17 -4 -4 5 -5 5 -3 5 3 -4 -64 0 3 5 -3 -4 -64 -64 49 29 -4 -4 5 -6 6 0 5 0 -4 -64 0 -4 3 -3 2 -3 -1 -1 -2 1 -2 3 -1 3 2 4 3 -64 -64 50 31 -4 -4 5 -5 6 -3 -4 -1 -4 -3 0 -3 2 -2 4 0 5 1 5 3 4 4 2 4 0 2 -4 4 -4 -64 -64 197 9 -4 -4 5 0 0 -64 0 -64 -64 198 9 -4 -4 5 -2 2 -64 0 -64 -64 199 9 -4 -4 5 -4 4 -64 0 -64 -64 200 29 -4 -4 5 -5 5 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 2 -3 3 -1 3 2 2 4 0 5 -64 -64 201 13 -4 -4 5 -5 5 -2 3 0 5 0 -4 -64 -64 202 23 -4 -4 5 -5 5 -3 4 -1 5 1 5 3 4 3 2 2 0 -3 -4 3 -4 -64 -64 203 35 -4 -4 5 -5 5 -3 4 -1 5 1 5 3 4 3 2 1 1 -64 0 0 1 1 1 3 0 3 -3 1 -4 -1 -4 -3 -3 -64 -64 204 19 -4 -4 5 -5 5 1 5 1 -4 -64 0 1 5 -4 -1 4 -1 -64 -64 205 33 -4 -4 5 -5 5 -2 5 -3 1 -1 2 0 2 2 1 3 -1 2 -3 0 -4 -1 -4 -3 -3 -64 0 -2 5 2 5 -64 -64 206 33 -4 -4 5 -5 5 2 5 0 5 -2 4 -3 2 -3 -1 -2 -3 0 -4 2 -3 3 -1 2 1 0 2 -2 1 -3 -1 -64 -64 207 17 -4 -4 5 -5 5 3 5 -1 -4 -64 0 -3 5 3 5 -64 -64 208 43 -4 -4 5 -5 5 -1 5 -3 4 -3 2 -1 1 1 1 3 2 3 4 1 5 -1 5 -64 0 -1 1 -3 0 -3 -3 -1 -4 1 -4 3 -3 3 0 1 1 -64 -64 209 33 -4 -4 5 -5 5 3 2 2 0 0 -1 -2 0 -3 2 -2 4 0 5 2 4 3 2 3 -1 2 -3 0 -4 -2 -4 -64 -64 210 17 -4 -4 5 -2 3 0 -3 0 -4 1 -4 1 -3 0 -3 -64 -64 211 19 -4 -4 5 -2 3 1 -4 0 -4 0 -3 1 -3 1 -5 0 -7 -64 -64 212 29 -4 -4 5 -2 3 0 2 0 1 1 1 1 2 0 2 -64 0 0 -3 0 -4 1 -4 1 -3 0 -3 -64 -64 213 31 -4 -4 5 -2 3 0 2 0 1 1 1 1 2 0 2 -64 0 1 -4 0 -4 0 -3 1 -3 1 -5 0 -7 -64 -64 214 29 -4 -4 5 -2 3 0 5 0 0 -64 0 1 5 1 0 -64 0 0 -3 0 -4 1 -4 1 -3 0 -3 -64 -64 215 39 -4 -4 5 -4 5 -2 4 0 5 1 5 3 4 3 2 0 1 0 0 1 0 1 1 3 2 -64 0 0 -3 0 -4 1 -4 1 -3 0 -3 -64 -64 216 11 -4 -4 5 -2 2 0 5 0 1 -64 -64 217 17 -4 -4 5 -4 4 -2 5 -2 1 -64 0 2 5 2 1 -64 -64 218 25 -4 -4 5 -4 4 -1 5 -2 4 -2 2 -1 1 1 1 2 2 2 4 1 5 -1 5 -64 -64 219 37 -4 -4 5 -5 5 3 4 1 5 -1 5 -3 4 -3 2 -1 1 2 0 3 -1 3 -3 1 -4 -1 -4 -3 -3 -64 0 0 6 0 -5 -64 -64 220 11 -4 -4 5 -5 5 4 6 -4 -5 -64 -64 221 19 -4 -4 5 -3 4 2 6 0 4 -1 2 -1 -1 0 -3 2 -5 -64 -64 222 19 -4 -4 5 -4 3 -2 6 0 4 1 2 1 -1 0 -3 -2 -5 -64 -64 223 11 -4 -4 5 -2 2 0 6 0 -5 -64 -64 224 11 -4 -4 5 -6 6 -4 0 4 0 -64 -64 225 17 -4 -4 5 -6 6 0 4 0 -4 -64 0 -4 0 4 0 -64 -64 226 17 -4 -4 5 -6 6 -4 2 4 2 -64 0 -4 -2 4 -2 -64 -64 227 17 -4 -4 5 -5 5 -3 3 3 -3 -64 0 3 3 -3 -3 -64 -64 228 23 -4 -4 5 -5 5 0 3 0 -3 -64 0 -3 2 3 -2 -64 0 3 2 -3 -2 -64 -64 229 17 -4 -4 5 -2 3 0 1 0 0 1 0 1 1 0 1 -64 -64 230 19 -4 -4 5 -2 3 1 5 0 3 0 1 1 1 1 2 0 2 -64 -64 231 19 -4 -4 5 -2 3 1 4 0 4 0 5 1 5 1 3 0 1 -64 -64 232 19 -4 -4 5 -6 6 1 3 4 0 1 -3 -64 0 -4 0 4 0 -64 -64 233 29 -4 -4 5 -5 6 0 6 -2 -5 -64 0 3 6 1 -5 -64 0 -3 2 4 2 -64 0 -3 -1 4 -1 -64 -64 234 47 -4 -4 5 -6 6 4 0 3 0 2 -1 1 -3 0 -4 -3 -4 -4 -3 -4 -1 -3 0 0 1 1 2 1 4 0 5 -2 5 -3 4 -3 2 -1 -1 1 -3 3 -4 4 -4 -64 -64 235 45 -4 -4 5 -6 6 -4 4 -3 1 -3 -1 -4 -4 -64 0 4 4 3 1 3 -1 4 -4 -64 0 -4 4 -1 3 1 3 4 4 -64 0 -4 -4 -1 -3 1 -3 4 -4 -64 -64 236 47 -4 -4 5 -5 5 1 -2 1 2 0 2 -1 2 -2 1 -2 -1 -1 -2 2 -2 4 0 4 1 3 3 1 4 -1 4 -3 3 -4 1 -4 -1 -3 -3 -1 -4 1 -4 3 -3 -64 -64 238 29 -16 -9 12 -10 10 -4 0 -5 1 -6 0 -5 -1 -4 0 -64 0 4 0 5 1 6 0 5 -1 4 0 -64 -64 239 69 -16 -9 12 -10 10 -5 2 -6 1 -6 0 -5 -1 -4 -1 -3 0 -3 1 -4 2 -5 2 -64 0 -5 1 -5 0 -4 0 -4 1 -5 1 -64 0 5 2 4 1 4 0 5 -1 6 -1 7 0 7 1 6 2 5 2 -64 0 5 1 5 0 6 0 6 1 5 1 -64 -64 240 11 -16 -9 12 -9 9 -7 0 7 0 -64 -64 242 17 -16 -9 12 -10 10 0 -3 -8 2 0 -2 8 2 0 -3 -64 -64 248 93 -16 -9 12 -12 12 -9 -1 -8 1 -6 2 -4 2 -2 1 2 -2 4 -3 6 -3 8 -2 9 1 -64 0 -9 -1 -8 2 -6 3 -4 3 -2 2 2 -1 4 -2 6 -2 8 -1 9 1 -64 0 -9 -7 -8 -5 -6 -4 -4 -4 -2 -5 2 -8 4 -9 6 -9 8 -8 9 -5 -64 0 -9 -7 -8 -4 -6 -3 -4 -3 -2 -4 2 -7 4 -8 6 -8 8 -7 9 -5 -64 -64 250 61 -16 -9 12 -12 12 -9 -1 -8 1 -6 2 -4 2 -2 1 2 -2 4 -3 6 -3 8 -2 9 1 -64 0 -9 -1 -8 2 -6 3 -4 3 -2 2 2 -1 4 -2 6 -2 8 -1 9 1 -64 0 -9 -5 9 -5 -64 0 -9 -9 9 -9 -64 -64 252 21 -16 -9 12 -15 15 -11 3 11 3 6 9 -64 0 -6 -9 -11 -3 11 -3 -64 -64 254 17 -16 -9 12 -14 14 -12 -12 12 -12 12 12 -12 12 -12 -12 -64 -64 256 63 -16 -9 12 -7 7 -1 -4 -3 -3 -4 -1 -4 1 -3 3 -1 4 1 4 3 3 4 1 4 -1 3 -3 1 -4 -1 -4 -64 0 1 -4 4 -1 -64 0 -1 -4 4 1 -64 0 -3 -3 3 3 -64 0 -4 -1 1 4 -64 0 -4 1 -1 4 -64 -64 258 11 -16 -9 12 -10 10 -9 0 9 0 -64 -64 259 17 -16 -9 12 -10 10 -9 0 9 0 -64 0 -9 1 9 1 -64 -64 261 101 -16 -9 12 -6 7 -2 12 1 15 1 2 -64 0 0 14 0 2 -64 0 -3 2 4 2 -64 0 -5 0 6 0 -64 0 -3 -4 -3 -5 -4 -5 -4 -4 -3 -3 -1 -2 2 -2 4 -3 5 -5 4 -7 2 -8 -1 -9 -3 -10 -4 -12 -4 -15 -64 0 2 -2 3 -3 4 -5 3 -7 2 -8 -64 0 -4 -14 -3 -13 -2 -13 1 -14 4 -14 5 -13 -64 0 -2 -13 1 -15 4 -15 5 -13 5 -12 -64 -64 262 109 -16 -9 12 -6 7 -2 12 1 15 1 2 -64 0 0 14 0 2 -64 0 -3 2 4 2 -64 0 -5 0 6 0 -64 0 -3 -4 -3 -5 -4 -5 -4 -4 -3 -3 -1 -2 2 -2 4 -3 5 -5 4 -7 2 -8 -64 0 2 -2 3 -3 4 -5 3 -7 2 -8 -64 0 0 -8 2 -8 4 -9 5 -11 5 -12 4 -14 2 -15 -1 -15 -3 -14 -4 -13 -4 -12 -3 -12 -3 -13 -64 0 2 -8 3 -9 4 -11 4 -12 3 -14 2 -15 -64 -64 263 103 -16 -9 12 -6 7 -2 12 1 15 1 2 -64 0 0 14 0 2 -64 0 -3 2 4 2 -64 0 -5 0 6 0 -64 0 4 -4 4 -5 5 -5 5 -4 4 -3 2 -2 0 -2 -2 -3 -3 -4 -4 -7 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -10 4 -8 2 -7 -1 -7 -4 -9 -64 0 0 -2 -2 -4 -3 -7 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -10 3 -8 2 -7 -64 -64 264 133 -16 -9 12 -6 7 -2 12 1 15 1 2 -64 0 0 14 0 2 -64 0 -3 2 4 2 -64 0 -5 0 6 0 -64 0 -1 -2 -3 -3 -4 -5 -3 -7 -1 -8 2 -8 4 -7 5 -5 4 -3 2 -2 -1 -2 -64 0 -1 -2 -2 -3 -3 -5 -2 -7 -1 -8 -64 0 2 -8 3 -7 4 -5 3 -3 2 -2 -64 0 -1 -8 -3 -9 -4 -11 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -11 4 -9 2 -8 -64 0 -1 -8 -2 -9 -3 -11 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -11 3 -9 2 -8 -64 -64 265 159 -16 -9 12 -6 7 -3 13 -3 12 -4 12 -4 13 -3 14 -1 15 2 15 4 14 5 12 4 10 2 9 -1 8 -3 7 -4 5 -4 2 -64 0 2 15 3 14 4 12 3 10 2 9 -64 0 -4 3 -3 4 -2 4 1 3 4 3 5 4 -64 0 -2 4 1 2 4 2 5 4 5 5 -64 0 -5 0 6 0 -64 0 -3 -4 -3 -5 -4 -5 -4 -4 -3 -3 -1 -2 2 -2 4 -3 5 -5 4 -7 2 -8 -64 0 2 -2 3 -3 4 -5 3 -7 2 -8 -64 0 0 -8 2 -8 4 -9 5 -11 5 -12 4 -14 2 -15 -1 -15 -3 -14 -4 -13 -4 -12 -3 -12 -3 -13 -64 0 2 -8 3 -9 4 -11 4 -12 3 -14 2 -15 -64 -64 266 191 -16 -9 12 -6 7 -3 13 -3 12 -4 12 -4 13 -3 14 -1 15 2 15 4 14 5 12 4 10 2 9 -64 0 2 15 3 14 4 12 3 10 2 9 -64 0 0 9 2 9 4 8 5 6 5 5 4 3 2 2 -1 2 -3 3 -4 4 -4 5 -3 5 -3 4 -64 0 2 9 3 8 4 6 4 5 3 3 2 2 -64 0 -5 0 6 0 -64 0 -1 -2 -3 -3 -4 -5 -3 -7 -1 -8 2 -8 4 -7 5 -5 4 -3 2 -2 -1 -2 -64 0 -1 -2 -2 -3 -3 -5 -2 -7 -1 -8 -64 0 2 -8 3 -7 4 -5 3 -3 2 -2 -64 0 -1 -8 -3 -9 -4 -11 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -11 4 -9 2 -8 -64 0 -1 -8 -2 -9 -3 -11 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -11 3 -9 2 -8 -64 -64 267 179 -16 -9 12 -6 7 -3 15 -4 9 -64 0 -3 15 4 15 -64 0 -3 14 1 14 4 15 -64 0 -4 9 -3 10 -1 11 2 11 4 10 5 8 5 5 4 3 2 2 -1 2 -3 3 -4 4 -4 5 -3 5 -3 4 -64 0 2 11 3 10 4 8 4 5 3 3 2 2 -64 0 -5 0 6 0 -64 0 -1 -2 -3 -3 -4 -5 -3 -7 -1 -8 2 -8 4 -7 5 -5 4 -3 2 -2 -1 -2 -64 0 -1 -2 -2 -3 -3 -5 -2 -7 -1 -8 -64 0 2 -8 3 -7 4 -5 3 -3 2 -2 -64 0 -1 -8 -3 -9 -4 -11 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -11 4 -9 2 -8 -64 0 -1 -8 -2 -9 -3 -11 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -11 3 -9 2 -8 -64 -64 268 157 -16 -9 12 -6 7 -4 15 -4 11 -64 0 4 13 0 6 -2 2 -64 0 5 15 2 9 -1 2 -64 0 -4 13 -2 15 0 15 3 13 -64 0 -4 13 -2 14 0 14 3 13 4 13 -64 0 -5 0 6 0 -64 0 -1 -2 -3 -3 -4 -5 -3 -7 -1 -8 2 -8 4 -7 5 -5 4 -3 2 -2 -1 -2 -64 0 -1 -2 -2 -3 -3 -5 -2 -7 -1 -8 -64 0 2 -8 3 -7 4 -5 3 -3 2 -2 -64 0 -1 -8 -3 -9 -4 -11 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -11 4 -9 2 -8 -64 0 -1 -8 -2 -9 -3 -11 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -11 3 -9 2 -8 -64 -64 269 149 -16 -9 12 -6 7 -3 15 -4 9 -64 0 -3 15 4 15 -64 0 -3 14 1 14 4 15 -64 0 -4 9 -3 10 -1 11 2 11 4 10 5 8 5 5 4 3 2 2 -1 2 -3 3 -4 4 -4 5 -3 5 -3 4 -64 0 2 11 3 10 4 8 4 5 3 3 2 2 -64 0 -5 0 6 0 -64 0 4 -4 4 -5 5 -5 5 -4 4 -3 2 -2 0 -2 -2 -3 -3 -4 -4 -7 -4 -12 -3 -14 -1 -15 2 -15 4 -14 5 -12 5 -10 4 -8 2 -7 -1 -7 -4 -9 -64 0 0 -2 -2 -4 -3 -7 -3 -12 -2 -14 -1 -15 -64 0 2 -15 3 -14 4 -12 4 -10 3 -8 2 -7 -64 -64 270 57 -16 -9 12 -6 7 -2 12 1 15 1 2 -64 0 0 14 0 2 -64 0 -3 2 4 2 -64 0 -5 0 6 0 -64 0 1 -4 1 -15 -64 0 2 -2 2 -15 -64 0 2 -2 -5 -11 6 -11 -64 0 -1 -15 4 -15 -64 -64 271 115 -16 -9 12 -6 7 -3 13 -3 12 -4 12 -4 13 -3 14 -1 15 2 15 4 14 5 12 4 10 2 9 -64 0 2 15 3 14 4 12 3 10 2 9 -64 0 0 9 2 9 4 8 5 6 5 5 4 3 2 2 -1 2 -3 3 -4 4 -4 5 -3 5 -3 4 -64 0 2 9 3 8 4 6 4 5 3 3 2 2 -64 0 -5 0 6 0 -64 0 1 -4 1 -15 -64 0 2 -2 2 -15 -64 0 2 -2 -5 -11 6 -11 -64 0 -1 -15 4 -15 -64 -64 272 83 -16 -9 12 -12 12 7 -6 5 -8 3 -9 0 -9 -2 -8 -5 -6 -7 -5 -9 -5 -10 -6 -10 -8 -9 -9 -7 -9 -5 -8 -3 -5 -2 -3 0 1 2 7 5 11 7 12 8 12 9 11 10 10 9 9 8 10 9 11 9 12 8 12 7 12 5 11 4 10 2 6 0 2 -2 -4 -4 -8 -5 -8 -64 0 -3 2 3 2 -64 -64 273 123 -16 -9 12 -13 12 -2 -9 -5 -8 -8 -6 -10 -3 -11 0 -11 3 -10 6 -8 9 -5 11 -2 12 2 12 5 11 7 9 9 6 10 3 10 0 9 -3 7 -6 4 -8 1 -9 -2 -9 -64 0 -4 8 -4 -5 -64 0 -3 8 -3 -5 -64 0 -6 8 1 8 4 7 5 5 5 4 4 2 1 1 -3 1 -64 0 1 8 3 7 4 5 4 4 3 2 1 1 -64 0 -6 -5 -1 -5 -64 0 1 1 2 0 3 -4 4 -5 5 -5 6 -4 -64 0 1 1 3 0 4 -4 5 -5 -64 -64 274 97 -16 -9 12 -13 12 -2 -9 -5 -8 -8 -6 -10 -3 -11 0 -11 3 -10 6 -8 9 -5 11 -2 12 2 12 5 11 7 9 9 6 10 3 10 0 9 -3 7 -6 4 -8 1 -9 -2 -9 -64 0 3 7 4 8 4 4 3 7 1 8 -2 8 -4 7 -5 6 -6 3 -6 0 -5 -3 -4 -4 -2 -5 1 -5 3 -4 4 -2 -64 0 -2 8 -4 6 -5 3 -5 0 -4 -3 -2 -5 -64 -64 275 29 -16 -9 12 -13 13 -9 5 9 5 -64 0 -9 0 9 0 -64 0 -9 -5 9 -5 -64 0 -7 -9 7 9 -64 -64 276 41 -16 -9 12 -15 15 -10 1 -11 0 -10 -1 -9 0 -10 1 -64 0 0 1 -1 0 0 -1 1 0 0 1 -64 0 10 1 9 0 10 -1 11 0 10 1 -64 -64 278 51 -16 -9 12 -13 13 -4 -5 -6 -2 -9 0 -6 2 -4 5 -64 0 -6 2 -8 0 -6 -2 -64 0 -8 0 8 0 -64 0 4 -5 6 -2 9 0 6 2 4 5 -64 0 6 2 8 0 6 -2 -64 -64 279 51 -16 -9 12 -8 8 5 4 2 6 0 9 -2 6 -5 4 -64 0 -2 6 0 8 2 6 -64 0 0 8 0 -8 -64 0 5 -4 2 -6 0 -9 -2 -6 -5 -4 -64 0 -2 -6 0 -8 2 -6 -64 -64 280 37 -16 -9 12 -12 12 8 8 1 8 -3 7 -5 6 -7 4 -8 1 -8 -1 -7 -4 -5 -6 -3 -7 1 -8 8 -8 -64 0 1 12 1 -12 -64 -64 281 37 -16 -9 12 -12 12 -8 8 -1 8 3 7 5 6 7 4 8 1 8 -1 7 -4 5 -6 3 -7 -1 -8 -8 -8 -64 0 -1 12 -1 -12 -64 -64 282 37 -16 -9 12 -12 12 -8 8 -1 8 3 7 5 6 7 4 8 1 8 -1 7 -4 5 -6 3 -7 -1 -8 -8 -8 -64 0 -3 0 8 0 -64 -64 284 23 -16 -9 12 -10 10 -6 16 -6 -9 -64 0 0 16 0 -9 -64 0 6 16 6 -9 -64 -64 501 23 -16 -9 12 -9 9 0 12 -8 -9 -64 0 0 12 8 -9 -64 0 -5 -2 5 -2 -64 -64 502 53 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 2 12 5 11 6 10 7 8 7 6 6 4 5 3 2 2 -64 0 -7 2 2 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -7 -9 -64 -64 503 43 -16 -9 12 -10 11 8 7 7 9 5 11 3 12 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 3 -9 5 -8 7 -6 8 -4 -64 -64 504 37 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 0 12 3 11 5 9 6 7 7 4 7 -1 6 -4 5 -6 3 -8 0 -9 -7 -9 -64 -64 505 29 -16 -9 12 -10 9 -6 12 -6 -9 -64 0 -6 12 7 12 -64 0 -6 2 2 2 -64 0 -6 -9 7 -9 -64 -64 506 23 -16 -9 12 -10 8 -6 12 -6 -9 -64 0 -6 12 7 12 -64 0 -6 2 2 2 -64 -64 507 51 -16 -9 12 -10 11 8 7 7 9 5 11 3 12 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 3 -9 5 -8 7 -6 8 -4 8 -1 -64 0 3 -1 8 -1 -64 -64 508 23 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 7 12 7 -9 -64 0 -7 2 7 2 -64 -64 509 11 -16 -9 12 -4 4 0 12 0 -9 -64 -64 510 27 -16 -9 12 -8 8 4 12 4 -4 3 -7 2 -8 0 -9 -2 -9 -4 -8 -5 -7 -6 -4 -6 -2 -64 -64 511 23 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 7 12 -7 -2 -64 0 -2 3 7 -9 -64 -64 512 17 -16 -9 12 -10 7 -6 12 -6 -9 -64 0 -6 -9 6 -9 -64 -64 513 29 -16 -9 12 -12 12 -8 12 -8 -9 -64 0 -8 12 0 -9 -64 0 8 12 0 -9 -64 0 8 12 8 -9 -64 -64 514 23 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 -7 12 7 -9 -64 0 7 12 7 -9 -64 -64 515 49 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 -64 516 33 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 2 12 5 11 6 10 7 8 7 5 6 3 5 2 2 1 -7 1 -64 -64 517 55 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 0 1 -5 7 -11 -64 -64 518 39 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 2 12 5 11 6 10 7 8 7 6 6 4 5 3 2 2 -7 2 -64 0 0 2 7 -9 -64 -64 519 47 -16 -9 12 -10 10 7 9 5 11 2 12 -2 12 -5 11 -7 9 -7 7 -6 5 -5 4 -3 3 3 1 5 0 6 -1 7 -3 7 -6 5 -8 2 -9 -2 -9 -5 -8 -7 -6 -64 -64 520 17 -16 -9 12 -8 8 0 12 0 -9 -64 0 -7 12 7 12 -64 -64 521 27 -16 -9 12 -11 11 -7 12 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 12 -64 -64 522 17 -16 -9 12 -9 9 -8 12 0 -9 -64 0 8 12 0 -9 -64 -64 523 29 -16 -9 12 -12 12 -10 12 -5 -9 -64 0 0 12 -5 -9 -64 0 0 12 5 -9 -64 0 10 12 5 -9 -64 -64 524 17 -16 -9 12 -10 10 -7 12 7 -9 -64 0 7 12 -7 -9 -64 -64 525 19 -16 -9 12 -9 9 -8 12 0 2 0 -9 -64 0 8 12 0 2 -64 -64 526 23 -16 -9 12 -10 10 7 12 -7 -9 -64 0 -7 12 7 12 -64 0 -7 -9 7 -9 -64 -64 527 23 -16 -9 12 -9 9 0 12 -8 -9 -64 0 0 12 8 -9 -64 0 -5 -2 5 -2 -64 -64 528 53 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 2 12 5 11 6 10 7 8 7 6 6 4 5 3 2 2 -64 0 -7 2 2 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -7 -9 -64 -64 529 17 -16 -9 12 -10 7 -6 12 -6 -9 -64 0 -6 12 6 12 -64 -64 530 23 -16 -9 12 -9 9 0 12 -8 -9 -64 0 0 12 8 -9 -64 0 -8 -9 8 -9 -64 -64 531 29 -16 -9 12 -10 9 -6 12 -6 -9 -64 0 -6 12 7 12 -64 0 -6 2 2 2 -64 0 -6 -9 7 -9 -64 -64 532 23 -16 -9 12 -10 10 7 12 -7 -9 -64 0 -7 12 7 12 -64 0 -7 -9 7 -9 -64 -64 533 23 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 7 12 7 -9 -64 0 -7 2 7 2 -64 -64 534 55 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 0 -3 2 3 2 -64 -64 535 11 -16 -9 12 -4 4 0 12 0 -9 -64 -64 536 23 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 7 12 -7 -2 -64 0 -2 3 7 -9 -64 -64 537 17 -16 -9 12 -9 9 0 12 -8 -9 -64 0 0 12 8 -9 -64 -64 538 29 -16 -9 12 -12 12 -8 12 -8 -9 -64 0 -8 12 0 -9 -64 0 8 12 0 -9 -64 0 8 12 8 -9 -64 -64 539 23 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 -7 12 7 -9 -64 0 7 12 7 -9 -64 -64 540 23 -16 -9 12 -9 9 -7 12 7 12 -64 0 -3 2 3 2 -64 0 -7 -9 7 -9 -64 -64 541 49 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 -64 542 23 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 7 12 7 -9 -64 0 -7 12 7 12 -64 -64 543 33 -16 -9 12 -11 10 -7 12 -7 -9 -64 0 -7 12 2 12 5 11 6 10 7 8 7 5 6 3 5 2 2 1 -7 1 -64 -64 544 25 -16 -9 12 -9 9 -7 12 0 2 -7 -9 -64 0 -7 12 7 12 -64 0 -7 -9 7 -9 -64 -64 545 17 -16 -9 12 -8 8 0 12 0 -9 -64 0 -7 12 7 12 -64 -64 546 43 -16 -9 12 -9 9 -7 7 -7 9 -6 11 -5 12 -3 12 -2 11 -1 9 0 5 0 -9 -64 0 7 7 7 9 6 11 5 12 3 12 2 11 1 9 0 5 -64 -64 547 47 -16 -9 12 -10 10 0 12 0 -9 -64 0 -2 7 -5 6 -6 5 -7 3 -7 0 -6 -2 -5 -3 -2 -4 2 -4 5 -3 6 -2 7 0 7 3 6 5 5 6 2 7 -2 7 -64 -64 548 17 -16 -9 12 -10 10 -7 12 7 -9 -64 0 -7 -9 7 12 -64 -64 549 41 -16 -9 12 -11 11 0 12 0 -9 -64 0 -9 6 -8 6 -7 5 -6 1 -5 -1 -4 -2 -1 -3 1 -3 4 -2 5 -1 6 1 7 5 8 6 9 6 -64 -64 550 39 -16 -9 12 -10 10 -7 -9 -3 -9 -6 -2 -7 2 -7 6 -6 9 -4 11 -1 12 1 12 4 11 6 9 7 6 7 2 6 -2 3 -9 7 -9 -64 -64 551 45 -16 -9 12 -11 9 -11 -9 -9 -8 -6 -5 -3 -1 1 6 4 12 4 -9 3 -6 1 -3 -1 -1 -4 1 -6 1 -7 0 -7 -2 -6 -4 -4 -6 -1 -8 2 -9 7 -9 -64 -64 552 87 -16 -9 12 -12 11 1 10 2 9 2 6 1 2 0 -1 -1 -3 -3 -6 -5 -8 -7 -9 -8 -9 -9 -8 -9 -5 -8 0 -7 3 -6 5 -4 8 -2 10 0 11 3 12 6 12 8 11 9 9 9 7 8 5 7 4 5 3 2 2 -64 0 1 2 2 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 0 -9 -2 -8 -3 -6 -64 -64 553 53 -16 -9 12 -10 10 2 6 2 5 3 4 5 4 7 5 8 7 8 9 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 4 -7 0 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -6 5 -4 -64 -64 554 75 -16 -9 12 -11 12 2 12 0 11 -1 9 -2 5 -3 -1 -4 -4 -5 -6 -7 -8 -9 -9 -11 -9 -12 -8 -12 -6 -11 -5 -9 -5 -7 -6 -5 -8 -2 -9 1 -9 4 -8 6 -6 8 -2 9 3 9 7 8 10 7 11 5 12 2 12 0 10 0 8 1 5 3 2 5 0 8 -2 10 -3 -64 -64 555 61 -16 -9 12 -10 10 4 8 4 7 5 6 7 6 8 7 8 9 7 11 4 12 0 12 -3 11 -4 9 -4 6 -3 4 -2 3 1 2 -2 2 -5 1 -6 0 -7 -2 -7 -5 -6 -7 -5 -8 -2 -9 1 -9 4 -8 6 -6 7 -4 -64 -64 556 61 -16 -9 12 -10 10 0 6 -2 6 -4 7 -5 9 -4 11 -1 12 2 12 6 11 9 11 11 12 -64 0 6 11 4 4 2 -2 0 -6 -2 -8 -4 -9 -6 -9 -8 -8 -9 -6 -9 -4 -8 -3 -6 -3 -4 -4 -64 0 -1 2 8 2 -64 -64 557 63 -16 -9 12 -11 12 -11 -9 -9 -8 -5 -4 -2 1 -1 4 0 8 0 11 -1 12 -2 12 -3 11 -4 9 -4 6 -3 4 -1 3 3 3 6 4 7 5 8 7 8 1 7 -4 6 -6 4 -8 1 -9 -3 -9 -6 -8 -8 -6 -9 -4 -9 -2 -64 -64 558 81 -16 -9 12 -12 12 -5 5 -7 6 -8 8 -8 9 -7 11 -5 12 -4 12 -2 11 -1 9 -1 7 -2 3 -4 -3 -6 -7 -8 -9 -10 -9 -11 -8 -11 -6 -64 0 -5 0 4 3 6 4 9 6 11 8 12 10 12 11 11 12 10 12 8 10 6 6 4 0 3 -5 3 -8 4 -9 5 -9 7 -8 8 -7 10 -4 -64 -64 559 55 -16 -9 12 -9 8 5 -4 3 -2 1 1 0 3 -1 6 -1 9 0 11 1 12 3 12 4 11 5 9 5 6 4 1 2 -4 1 -6 -1 -8 -3 -9 -5 -9 -7 -8 -8 -6 -8 -4 -7 -3 -5 -3 -3 -4 -64 -64 560 55 -16 -9 12 -8 7 2 -12 0 -9 -2 -4 -3 2 -3 8 -2 11 0 12 2 12 3 11 4 8 4 5 3 0 0 -9 -2 -15 -3 -18 -4 -20 -6 -21 -7 -20 -7 -18 -6 -15 -4 -12 -2 -10 1 -8 5 -6 -64 -64 561 83 -16 -9 12 -12 12 -5 5 -7 6 -8 8 -8 9 -7 11 -5 12 -4 12 -2 11 -1 9 -1 7 -2 3 -4 -3 -6 -7 -8 -9 -10 -9 -11 -8 -11 -6 -64 0 12 9 12 11 11 12 10 12 8 11 6 9 4 6 2 4 0 3 -2 3 -64 0 0 3 1 1 1 -6 2 -8 3 -9 4 -9 6 -8 7 -7 9 -4 -64 -64 562 63 -16 -9 12 -9 10 -5 0 -3 0 1 1 4 3 6 5 7 7 7 10 6 12 4 12 3 11 2 9 1 4 0 -1 -1 -4 -2 -6 -4 -8 -6 -9 -8 -9 -9 -8 -9 -6 -8 -5 -6 -5 -4 -6 -1 -8 2 -9 4 -9 7 -8 9 -6 -64 -64 563 95 -16 -9 12 -18 15 -13 5 -15 6 -16 8 -16 9 -15 11 -13 12 -12 12 -10 11 -9 9 -9 7 -10 2 -11 -2 -13 -9 -64 0 -11 -2 -8 6 -6 10 -5 11 -3 12 -2 12 0 11 1 9 1 7 0 2 -1 -2 -3 -9 -64 0 -1 -2 2 6 4 10 5 11 7 12 8 12 10 11 11 9 11 7 10 2 8 -5 8 -8 9 -9 10 -9 12 -8 13 -7 15 -4 -64 -64 564 69 -16 -9 12 -13 11 -8 5 -10 6 -11 8 -11 9 -10 11 -8 12 -7 12 -5 11 -4 9 -4 7 -5 2 -6 -2 -8 -9 -64 0 -6 -2 -3 6 -1 10 0 11 2 12 4 12 6 11 7 9 7 7 6 2 4 -5 4 -8 5 -9 6 -9 8 -8 9 -7 11 -4 -64 -64 565 63 -16 -9 12 -10 11 2 12 -1 11 -3 9 -5 6 -6 4 -7 0 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -6 6 -3 7 -1 8 3 8 7 7 10 6 11 4 12 2 12 0 10 0 7 1 4 3 1 5 -1 8 -3 10 -4 -64 -64 566 67 -16 -9 12 -12 13 1 10 2 9 2 6 1 2 0 -1 -1 -3 -3 -6 -5 -8 -7 -9 -8 -9 -9 -8 -9 -5 -8 0 -7 3 -6 5 -4 8 -2 10 0 11 3 12 8 12 10 11 11 10 12 8 12 5 11 3 10 2 8 1 5 1 3 2 2 3 -64 -64 567 69 -16 -9 12 -10 12 3 6 2 4 1 3 -1 2 -3 2 -4 4 -4 6 -3 9 -1 11 2 12 5 12 7 11 8 9 8 5 7 2 5 -1 1 -5 -2 -7 -4 -8 -7 -9 -9 -9 -10 -8 -10 -6 -9 -5 -7 -5 -5 -6 -2 -8 1 -9 4 -9 7 -8 9 -6 -64 -64 568 81 -16 -9 12 -12 13 1 10 2 9 2 6 1 2 0 -1 -1 -3 -3 -6 -5 -8 -7 -9 -8 -9 -9 -8 -9 -5 -8 0 -7 3 -6 5 -4 8 -2 10 0 11 3 12 7 12 9 11 10 10 11 8 11 5 10 3 9 2 7 1 4 1 1 2 2 1 3 -1 3 -6 4 -8 6 -9 8 -8 9 -7 11 -4 -64 -64 569 61 -16 -9 12 -10 10 -10 -9 -8 -8 -6 -6 -3 -2 -1 1 1 5 2 8 2 11 1 12 0 12 -1 11 -2 9 -2 7 -1 5 1 3 4 1 6 -1 7 -3 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -7 -6 -8 -4 -8 -2 -64 -64 570 55 -16 -9 12 -10 9 0 6 -2 6 -4 7 -5 9 -4 11 -1 12 2 12 6 11 9 11 11 12 -64 0 6 11 4 4 2 -2 0 -6 -2 -8 -4 -9 -6 -9 -8 -8 -9 -6 -9 -4 -8 -3 -6 -3 -4 -4 -64 -64 571 71 -16 -9 12 -13 11 -8 5 -10 6 -11 8 -11 9 -10 11 -8 12 -7 12 -5 11 -4 9 -4 7 -5 3 -6 0 -7 -4 -7 -6 -6 -8 -4 -9 -2 -9 0 -8 1 -7 3 -3 6 5 8 12 -64 0 6 5 5 1 4 -5 4 -8 5 -9 6 -9 8 -8 9 -7 11 -4 -64 -64 572 69 -16 -9 12 -12 11 -7 5 -9 6 -10 8 -10 9 -9 11 -7 12 -6 12 -4 11 -3 9 -3 7 -4 3 -5 0 -6 -4 -6 -7 -5 -9 -3 -9 -1 -8 2 -5 4 -2 6 2 7 5 8 9 8 11 7 12 6 12 5 11 4 9 4 7 5 4 7 2 9 1 -64 -64 573 55 -16 -9 12 -15 13 -10 5 -12 6 -13 8 -13 9 -12 11 -10 12 -9 12 -7 11 -6 9 -6 6 -7 -9 -64 0 3 12 -7 -9 -64 0 3 12 1 -9 -64 0 15 12 13 11 10 8 7 4 4 -2 1 -9 -64 -64 574 77 -16 -9 12 -12 12 -4 6 -6 6 -7 7 -7 9 -6 11 -4 12 -2 12 0 11 1 9 1 6 -1 -3 -1 -6 0 -8 2 -9 4 -9 6 -8 7 -6 7 -4 6 -3 4 -3 -64 0 11 9 11 11 10 12 8 12 6 11 4 9 2 6 -2 -3 -4 -6 -6 -8 -8 -9 -10 -9 -11 -8 -11 -6 -64 -64 575 81 -16 -9 12 -12 11 -7 5 -9 6 -10 8 -10 9 -9 11 -7 12 -6 12 -4 11 -3 9 -3 7 -4 3 -5 0 -6 -4 -6 -6 -5 -8 -4 -9 -2 -9 0 -8 2 -6 4 -3 5 -1 7 5 -64 0 9 12 7 5 4 -5 2 -11 0 -16 -2 -20 -4 -21 -5 -20 -5 -18 -4 -15 -2 -12 1 -9 4 -7 9 -4 -64 -64 576 85 -16 -9 12 -10 11 3 6 2 4 1 3 -1 2 -3 2 -4 4 -4 6 -3 9 -1 11 2 12 5 12 7 11 8 9 8 5 7 2 5 -2 2 -5 -2 -8 -4 -9 -7 -9 -8 -8 -8 -6 -7 -5 -4 -5 -2 -6 -1 -7 0 -9 0 -12 -1 -15 -2 -17 -4 -20 -6 -21 -7 -20 -7 -18 -6 -15 -4 -12 -1 -9 2 -7 8 -4 -64 -64 583 23 -16 -9 12 -9 9 -8 12 0 -9 -64 0 8 12 0 -9 -64 0 -8 12 8 12 -64 -64 590 11 -16 -9 12 -9 10 -9 -11 9 -11 -64 -64 601 41 -16 -9 12 -9 10 6 5 6 -9 -64 0 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 602 41 -16 -9 12 -10 9 -6 12 -6 -9 -64 0 -6 2 -4 4 -2 5 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -2 -9 -4 -8 -6 -6 -64 -64 603 35 -16 -9 12 -9 9 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 604 41 -16 -9 12 -9 10 6 12 6 -9 -64 0 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 605 41 -16 -9 12 -9 9 -6 -1 6 -1 6 1 5 3 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 606 23 -16 -9 12 -5 7 5 12 3 12 1 11 0 8 0 -9 -64 0 -3 5 4 5 -64 -64 607 51 -16 -9 12 -9 10 6 5 6 -11 5 -14 4 -15 2 -16 -1 -16 -3 -15 -64 0 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 608 27 -16 -9 12 -9 10 -5 12 -5 -9 -64 0 -5 1 -2 4 0 5 3 5 5 4 6 1 6 -9 -64 -64 609 23 -16 -9 12 -4 4 -1 12 0 11 1 12 0 13 -1 12 -64 0 0 5 0 -9 -64 -64 610 29 -16 -9 12 -5 5 0 12 1 11 2 12 1 13 0 12 -64 0 1 5 1 -12 0 -15 -2 -16 -4 -16 -64 -64 611 23 -16 -9 12 -9 8 -5 12 -5 -9 -64 0 5 5 -5 -5 -64 0 -1 -1 6 -9 -64 -64 612 11 -16 -9 12 -4 4 0 12 0 -9 -64 -64 613 43 -16 -9 12 -15 15 -11 5 -11 -9 -64 0 -11 1 -8 4 -6 5 -3 5 -1 4 0 1 0 -9 -64 0 0 1 3 4 5 5 8 5 10 4 11 1 11 -9 -64 -64 614 27 -16 -9 12 -9 10 -5 5 -5 -9 -64 0 -5 1 -2 4 0 5 3 5 5 4 6 1 6 -9 -64 -64 615 41 -16 -9 12 -9 10 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 2 5 -1 5 -64 -64 616 41 -16 -9 12 -10 9 -6 5 -6 -16 -64 0 -6 2 -4 4 -2 5 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -2 -9 -4 -8 -6 -6 -64 -64 617 41 -16 -9 12 -9 10 6 5 6 -16 -64 0 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 -64 618 23 -16 -9 12 -7 6 -3 5 -3 -9 -64 0 -3 -1 -2 2 0 4 2 5 5 5 -64 -64 619 41 -16 -9 12 -8 9 6 2 5 4 2 5 -1 5 -4 4 -5 2 -4 0 -2 -1 3 -2 5 -3 6 -5 6 -6 5 -8 2 -9 -1 -9 -4 -8 -5 -6 -64 -64 620 23 -16 -9 12 -5 7 0 12 0 -5 1 -8 3 -9 5 -9 -64 0 -3 5 4 5 -64 -64 621 27 -16 -9 12 -9 10 -5 5 -5 -5 -4 -8 -2 -9 1 -9 3 -8 6 -5 -64 0 6 5 6 -9 -64 -64 622 17 -16 -9 12 -8 8 -6 5 0 -9 -64 0 6 5 0 -9 -64 -64 623 29 -16 -9 12 -11 11 -8 5 -4 -9 -64 0 0 5 -4 -9 -64 0 0 5 4 -9 -64 0 8 5 4 -9 -64 -64 624 17 -16 -9 12 -8 9 -5 5 6 -9 -64 0 6 5 -5 -9 -64 -64 625 25 -16 -9 12 -8 8 -6 5 0 -9 -64 0 6 5 0 -9 -2 -13 -4 -15 -6 -16 -7 -16 -64 -64 626 23 -16 -9 12 -8 9 6 5 -5 -9 -64 0 -5 5 6 5 -64 0 -5 -9 6 -9 -64 -64 627 53 -16 -9 12 -10 11 -1 5 -3 4 -5 2 -6 0 -7 -3 -7 -6 -6 -8 -4 -9 -2 -9 0 -8 3 -5 5 -2 7 2 8 5 -64 0 -1 5 1 5 2 4 3 2 5 -6 6 -8 7 -9 8 -9 -64 -64 628 67 -16 -9 12 -9 10 3 12 1 11 -1 9 -3 5 -4 2 -5 -2 -6 -8 -7 -16 -64 0 3 12 5 12 7 10 7 7 6 5 5 4 3 3 0 3 -64 0 0 3 2 2 4 0 5 -2 5 -5 4 -7 3 -8 1 -9 -1 -9 -3 -8 -4 -7 -5 -4 -64 -64 629 39 -16 -9 12 -9 10 -8 2 -6 4 -4 5 -3 5 -1 4 0 3 1 0 1 -4 0 -9 -64 0 8 5 7 2 6 0 0 -9 -2 -13 -3 -16 -64 -64 630 53 -16 -9 12 -9 9 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 2 -8 4 -6 5 -3 5 0 4 3 2 5 0 7 -1 9 -1 11 0 12 2 12 4 11 6 9 -64 -64 631 43 -16 -9 12 -8 8 5 3 4 4 2 5 -1 5 -3 4 -3 2 -2 0 1 -1 -64 0 1 -1 -3 -2 -5 -4 -5 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 -64 -64 632 51 -16 -9 12 -8 7 2 12 0 11 -1 10 -1 9 0 8 3 7 6 7 -64 0 6 7 2 5 -1 3 -4 0 -5 -3 -5 -5 -4 -7 -2 -9 1 -11 2 -13 2 -15 1 -16 -1 -16 -2 -14 -64 -64 633 43 -16 -9 12 -10 10 -9 1 -8 3 -6 5 -4 5 -3 4 -3 2 -4 -2 -6 -9 -64 0 -4 -2 -2 2 0 4 2 5 4 5 6 3 6 0 5 -5 2 -16 -64 -64 634 59 -16 -9 12 -11 10 -10 1 -9 3 -7 5 -5 5 -4 4 -4 2 -5 -3 -5 -6 -4 -8 -3 -9 -1 -9 1 -8 3 -5 4 -3 5 0 6 5 6 8 5 11 3 12 1 12 0 10 0 8 1 5 3 2 5 0 8 -2 -64 -64 635 23 -16 -9 12 -6 5 0 5 -2 -2 -3 -6 -3 -8 -2 -9 0 -9 2 -7 3 -5 -64 -64 636 43 -16 -9 12 -9 9 -3 5 -7 -9 -64 0 7 4 6 5 5 5 3 4 -1 0 -3 -1 -4 -1 -64 0 -4 -1 -2 -2 -1 -3 1 -8 2 -9 3 -9 4 -8 -64 -64 637 23 -16 -9 12 -8 8 -7 12 -5 12 -3 11 -2 10 6 -9 -64 0 0 5 -6 -9 -64 -64 638 47 -16 -9 12 -10 11 -3 5 -9 -16 -64 0 -4 1 -5 -4 -5 -7 -3 -9 -1 -9 1 -8 3 -6 5 -2 -64 0 7 5 5 -2 4 -6 4 -8 5 -9 7 -9 9 -7 10 -5 -64 -64 639 33 -16 -9 12 -9 9 -6 5 -3 5 -4 -1 -5 -6 -6 -9 -64 0 7 5 6 2 5 0 3 -3 0 -6 -3 -8 -6 -9 -64 -64 640 63 -16 -9 12 -8 8 2 12 0 11 -1 10 -1 9 0 8 3 7 6 7 -64 0 3 7 0 6 -2 5 -3 3 -3 1 -1 -1 2 -2 4 -2 -64 0 2 -2 -2 -3 -4 -4 -5 -6 -5 -8 -3 -10 1 -12 2 -13 2 -15 0 -16 -2 -16 -64 -64 641 41 -16 -9 12 -8 9 0 5 -2 4 -4 2 -5 -1 -5 -4 -4 -7 -3 -8 -1 -9 1 -9 3 -8 5 -6 6 -3 6 0 5 3 4 4 2 5 0 5 -64 -64 642 31 -16 -9 12 -11 11 -2 5 -6 -9 -64 0 3 5 4 -1 5 -6 6 -9 -64 0 -9 2 -7 4 -4 5 9 5 -64 -64 643 43 -16 -9 12 -9 9 -5 -1 -5 -4 -4 -7 -3 -8 -1 -9 1 -9 3 -8 5 -6 6 -3 6 0 5 3 4 4 2 5 0 5 -2 4 -4 2 -5 -1 -9 -16 -64 -64 644 41 -16 -9 12 -9 11 9 5 -1 5 -3 4 -5 2 -6 -1 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 2 -8 4 -6 5 -3 5 0 4 3 3 4 1 5 -64 -64 645 21 -16 -9 12 -10 10 1 5 -2 -9 -64 0 -8 2 -6 4 -3 5 8 5 -64 -64 646 37 -16 -9 12 -10 10 -9 1 -8 3 -6 5 -4 5 -3 4 -3 2 -5 -4 -5 -7 -3 -9 -1 -9 2 -8 4 -6 6 -2 7 2 7 5 -64 -64 647 47 -16 -9 12 -11 11 -3 4 -5 3 -7 1 -8 -2 -8 -5 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 5 -6 7 -3 8 0 8 3 6 5 4 5 2 3 0 -1 -2 -6 -5 -16 -64 -64 648 33 -16 -9 12 -9 9 -7 5 -5 5 -3 3 3 -14 5 -16 7 -16 -64 0 8 5 7 3 5 0 -5 -11 -7 -14 -8 -16 -64 -64 649 45 -16 -9 12 -12 11 4 12 -4 -16 -64 0 -11 1 -10 3 -8 5 -6 5 -5 4 -5 2 -6 -3 -6 -6 -5 -8 -3 -9 -1 -9 2 -8 4 -6 6 -3 8 2 9 5 -64 -64 650 51 -16 -9 12 -12 11 -4 5 -6 4 -8 1 -9 -2 -9 -5 -8 -8 -7 -9 -5 -9 -3 -8 -1 -5 -64 0 0 -1 -1 -5 0 -8 1 -9 3 -9 5 -8 7 -5 8 -2 8 1 7 4 6 5 -64 -64 651 49 -16 -9 12 -6 10 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -6 4 0 3 -5 3 -8 4 -9 5 -9 7 -8 8 -7 10 -4 -64 -64 652 51 -16 -9 12 -5 9 -5 -4 -3 -1 0 4 1 6 2 9 2 11 1 12 -1 11 -2 9 -3 5 -4 -2 -4 -8 -3 -9 -2 -9 0 -8 2 -6 3 -3 3 0 4 -4 5 -5 7 -5 9 -4 -64 -64 653 33 -16 -9 12 -5 6 2 -2 2 -1 1 0 -1 0 -3 -1 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 1 -9 4 -7 6 -4 -64 -64 654 53 -16 -9 12 -6 10 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -6 8 12 -64 0 4 0 3 -5 3 -8 4 -9 5 -9 7 -8 8 -7 10 -4 -64 -64 655 39 -16 -9 12 -4 6 -3 -7 -1 -6 0 -5 1 -3 1 -1 0 0 -1 0 -3 -1 -4 -3 -4 -6 -3 -8 -1 -9 1 -9 3 -8 4 -7 6 -4 -64 -64 656 53 -16 -9 12 -3 5 -3 -4 1 1 3 4 4 6 5 9 5 11 4 12 2 11 1 9 -1 1 -4 -8 -7 -15 -8 -18 -8 -20 -7 -21 -5 -20 -4 -17 -3 -8 -2 -9 0 -9 2 -8 3 -7 5 -4 -64 -64 657 61 -16 -9 12 -6 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -7 -64 0 4 0 2 -7 -2 -18 -3 -20 -5 -21 -6 -20 -6 -18 -5 -15 -2 -12 1 -10 3 -9 6 -7 9 -4 -64 -64 658 63 -16 -9 12 -5 10 -5 -4 -3 -1 0 4 1 6 2 9 2 11 1 12 -1 11 -2 9 -3 5 -4 -1 -5 -9 -64 0 -5 -9 -4 -6 -3 -4 -1 -1 1 0 3 0 4 -1 4 -3 3 -6 3 -8 4 -9 5 -9 7 -8 8 -7 10 -4 -64 -64 659 37 -16 -9 12 -2 5 1 5 1 4 2 4 2 5 1 5 -64 0 -2 -4 0 0 -2 -6 -2 -8 -1 -9 0 -9 2 -8 3 -7 5 -4 -64 -64 660 45 -16 -9 12 -2 5 1 5 1 4 2 4 2 5 1 5 -64 0 -2 -4 0 0 -6 -18 -7 -20 -9 -21 -10 -20 -10 -18 -9 -15 -6 -12 -3 -10 -1 -9 2 -7 5 -4 -64 -64 661 71 -16 -9 12 -5 9 -5 -4 -3 -1 0 4 1 6 2 9 2 11 1 12 -1 11 -2 9 -3 5 -4 -1 -5 -9 -64 0 -5 -9 -4 -6 -3 -4 -1 -1 1 0 3 0 4 -1 4 -3 2 -4 -1 -4 -64 0 -1 -4 1 -5 2 -8 3 -9 4 -9 6 -8 7 -7 9 -4 -64 -64 662 41 -16 -9 12 -3 5 -3 -4 -1 -1 2 4 3 6 4 9 4 11 3 12 1 11 0 9 -1 5 -2 -2 -2 -8 -1 -9 0 -9 2 -8 3 -7 5 -4 -64 -64 663 71 -16 -9 12 -13 12 -13 -4 -11 -1 -9 0 -8 -1 -8 -2 -9 -6 -10 -9 -64 0 -9 -6 -8 -4 -6 -1 -4 0 -2 0 -1 -1 -1 -2 -2 -6 -3 -9 -64 0 -2 -6 -1 -4 1 -1 3 0 5 0 6 -1 6 -3 5 -6 5 -8 6 -9 7 -9 9 -8 10 -7 12 -4 -64 -64 664 51 -16 -9 12 -8 10 -8 -4 -6 -1 -4 0 -3 -1 -3 -2 -4 -6 -5 -9 -64 0 -4 -6 -3 -4 -1 -1 1 0 3 0 4 -1 4 -3 3 -6 3 -8 4 -9 5 -9 7 -8 8 -7 10 -4 -64 -64 665 51 -16 -9 12 -6 8 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -7 3 -5 3 -3 2 -1 0 0 -1 -1 -1 -3 0 -5 2 -6 5 -6 7 -5 8 -4 -64 -64 666 53 -16 -9 12 -7 8 -7 -4 -5 -1 -4 1 -5 -3 -11 -21 -64 0 -5 -3 -4 -1 -2 0 0 0 2 -1 3 -3 3 -5 2 -7 1 -8 -1 -9 -64 0 -5 -8 -3 -9 0 -9 3 -8 5 -7 8 -4 -64 -64 667 59 -16 -9 12 -6 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 -64 0 4 0 3 -3 1 -8 -2 -15 -3 -18 -3 -20 -2 -21 0 -20 1 -17 1 -10 3 -9 6 -7 9 -4 -64 -64 668 35 -16 -9 12 -5 8 -5 -4 -3 -1 -2 1 -2 -1 1 -1 2 -2 2 -4 1 -7 1 -8 2 -9 3 -9 5 -8 6 -7 8 -4 -64 -64 669 37 -16 -9 12 -4 7 -4 -4 -2 -1 -1 1 -1 -1 1 -4 2 -6 2 -8 0 -9 -64 0 -4 -8 -2 -9 2 -9 4 -8 5 -7 7 -4 -64 -64 670 37 -16 -9 12 -3 6 -3 -4 -1 -1 1 3 -64 0 4 12 -2 -6 -2 -8 -1 -9 1 -9 3 -8 4 -7 6 -4 -64 0 -2 4 5 4 -64 -64 671 43 -16 -9 12 -6 9 -6 -4 -4 0 -6 -6 -6 -8 -5 -9 -3 -9 -1 -8 1 -6 3 -3 -64 0 4 0 2 -6 2 -8 3 -9 4 -9 6 -8 7 -7 9 -4 -64 -64 672 39 -16 -9 12 -6 9 -6 -4 -4 0 -5 -5 -5 -8 -4 -9 -3 -9 0 -8 2 -6 3 -3 3 0 -64 0 3 0 4 -4 5 -5 7 -5 9 -4 -64 -64 673 55 -16 -9 12 -9 12 -6 0 -8 -2 -9 -5 -9 -7 -8 -9 -6 -9 -4 -8 -2 -6 -64 0 0 0 -2 -6 -2 -8 -1 -9 1 -9 3 -8 5 -6 6 -3 6 0 -64 0 6 0 7 -4 8 -5 10 -5 12 -4 -64 -64 674 45 -16 -9 12 -8 8 -8 -4 -6 -1 -4 0 -2 0 -1 -1 -1 -8 0 -9 3 -9 6 -7 8 -4 -64 0 5 -1 4 0 2 0 1 -1 -3 -8 -4 -9 -6 -9 -7 -8 -64 -64 675 51 -16 -9 12 -6 9 -6 -4 -4 0 -6 -6 -6 -8 -5 -9 -3 -9 -1 -8 1 -6 3 -3 -64 0 4 0 -2 -18 -3 -20 -5 -21 -6 -20 -6 -18 -5 -15 -2 -12 1 -10 3 -9 6 -7 9 -4 -64 -64 676 51 -16 -9 12 -6 8 -6 -4 -4 -1 -2 0 0 0 2 -2 2 -4 1 -6 -1 -8 -4 -9 -2 -10 -1 -12 -1 -15 -2 -18 -3 -20 -5 -21 -6 -20 -6 -18 -5 -15 -2 -12 1 -10 5 -7 8 -4 -64 -64 677 49 -16 -9 12 -8 10 -7 -9 -4 -8 -1 -6 1 -4 3 -1 5 3 6 7 6 9 5 11 3 12 1 11 0 10 -1 8 -2 3 -2 -2 -1 -6 0 -8 2 -9 4 -9 6 -8 7 -7 -64 -64 683 57 -16 -9 12 -9 9 5 -3 5 0 4 3 3 4 1 5 -1 5 -3 4 -5 2 -6 -1 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 2 -8 4 -6 5 -3 6 2 6 7 5 10 4 11 2 12 0 12 -2 11 -4 9 -64 -64 684 37 -16 -9 12 -8 8 5 4 3 5 0 5 -2 4 -4 2 -5 -1 -5 -4 -4 -7 -3 -8 -1 -9 2 -9 4 -8 -64 0 -5 -2 3 -2 -64 -64 685 51 -16 -9 12 -8 9 2 12 0 11 -2 8 -3 6 -4 3 -5 -2 -5 -6 -4 -8 -3 -9 -1 -9 1 -8 3 -5 4 -3 5 0 6 5 6 9 5 11 4 12 2 12 -64 0 -4 2 5 2 -64 -64 686 47 -16 -9 12 -10 10 4 12 -4 -16 -64 0 -1 5 -4 4 -6 2 -7 -1 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 0 6 2 4 4 1 5 -1 5 -64 -64 687 37 -16 -9 12 -9 9 6 3 5 4 2 5 -1 5 -4 4 -5 3 -6 1 -6 -1 -5 -3 -3 -5 1 -8 2 -10 2 -12 1 -13 -1 -13 -64 -64 697 9 -16 -9 12 0 0 -64 0 -64 -64 698 9 -16 -9 12 -4 4 -64 0 -64 -64 699 9 -16 -9 12 -8 8 -64 0 -64 -64 700 41 -16 -9 12 -10 10 -1 12 -4 11 -6 8 -7 3 -7 0 -6 -5 -4 -8 -1 -9 1 -9 4 -8 6 -5 7 0 7 3 6 8 4 11 1 12 -1 12 -64 -64 701 15 -16 -9 12 -10 10 -4 8 -2 9 1 12 1 -9 -64 -64 702 35 -16 -9 12 -10 10 -6 7 -6 8 -5 10 -4 11 -2 12 2 12 4 11 5 10 6 8 6 6 5 4 3 1 -7 -9 7 -9 -64 -64 703 37 -16 -9 12 -10 10 -5 12 6 12 0 4 3 4 5 3 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -64 -64 704 19 -16 -9 12 -10 10 3 12 -7 -2 8 -2 -64 0 3 12 3 -9 -64 -64 705 41 -16 -9 12 -10 10 5 12 -5 12 -6 3 -5 4 -2 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -64 -64 706 53 -16 -9 12 -10 10 6 9 5 11 2 12 0 12 -3 11 -5 8 -6 3 -6 -2 -5 -6 -3 -8 0 -9 1 -9 4 -8 6 -6 7 -3 7 -2 6 1 4 3 1 4 0 4 -3 3 -5 1 -6 -2 -64 -64 707 17 -16 -9 12 -10 10 7 12 -3 -9 -64 0 -7 12 7 12 -64 -64 708 65 -16 -9 12 -10 10 -2 12 -5 11 -6 9 -6 7 -5 5 -3 4 1 3 4 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -2 -6 0 -4 2 -1 3 3 4 5 5 6 7 6 9 5 11 2 12 -2 12 -64 -64 709 53 -16 -9 12 -10 10 6 5 5 2 3 0 0 -1 -1 -1 -4 0 -6 2 -7 5 -7 6 -6 9 -4 11 -1 12 0 12 3 11 5 9 6 5 6 0 5 -5 3 -8 0 -9 -2 -9 -5 -8 -6 -6 -64 -64 710 17 -16 -9 12 -5 5 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 711 23 -16 -9 12 -5 5 1 -8 0 -9 -1 -8 0 -7 1 -8 1 -10 0 -12 -1 -13 -64 -64 712 29 -16 -9 12 -5 5 0 5 -1 4 0 3 1 4 0 5 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 713 35 -16 -9 12 -5 5 0 5 -1 4 0 3 1 4 0 5 -64 0 1 -8 0 -9 -1 -8 0 -7 1 -8 1 -10 0 -12 -1 -13 -64 -64 714 23 -16 -9 12 -5 5 0 12 0 -2 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 715 47 -16 -9 12 -9 9 -6 7 -6 8 -5 10 -4 11 -2 12 2 12 4 11 5 10 6 8 6 6 5 4 4 3 0 1 0 -2 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 716 11 -16 -9 12 -4 4 0 12 0 5 -64 -64 717 17 -16 -9 12 -8 8 -4 12 -4 5 -64 0 4 12 4 5 -64 -64 718 33 -16 -9 12 -7 7 -1 12 -3 11 -4 9 -4 7 -3 5 -1 4 1 4 3 5 4 7 4 9 3 11 1 12 -1 12 -64 -64 719 59 -16 -9 12 -10 10 -2 16 -2 -13 -64 0 2 16 2 -13 -64 0 7 9 5 11 2 12 -2 12 -5 11 -7 9 -7 7 -6 5 -5 4 -3 3 3 1 5 0 6 -1 7 -3 7 -6 5 -8 2 -9 -2 -9 -5 -8 -7 -6 -64 -64 720 11 -16 -9 12 -11 11 9 16 -9 -16 -64 -64 721 27 -16 -9 12 -7 7 4 16 2 14 0 11 -2 7 -3 2 -3 -2 -2 -7 0 -11 2 -14 4 -16 -64 -64 722 27 -16 -9 12 -7 7 -4 16 -2 14 0 11 2 7 3 2 3 -2 2 -7 0 -11 -2 -14 -4 -16 -64 -64 723 11 -16 -9 12 -4 4 0 16 0 -16 -64 -64 724 11 -16 -9 12 -13 13 -9 0 9 0 -64 -64 725 17 -16 -9 12 -13 13 0 9 0 -9 -64 0 -9 0 9 0 -64 -64 726 17 -16 -9 12 -13 13 -9 3 9 3 -64 0 -9 -3 9 -3 -64 -64 727 17 -16 -9 12 -11 11 -7 7 7 -7 -64 0 7 7 -7 -7 -64 -64 728 23 -16 -9 12 -8 8 0 6 0 -6 -64 0 -5 3 5 -3 -64 0 5 3 -5 -3 -64 -64 729 17 -16 -9 12 -5 5 0 1 -1 0 0 -1 1 0 0 1 -64 -64 730 21 -16 -9 12 -5 5 1 12 0 11 -1 9 -1 7 0 6 1 7 0 8 -64 -64 731 21 -16 -9 12 -5 5 0 10 -1 11 0 12 1 11 1 9 0 7 -1 6 -64 -64 732 23 -16 -9 12 -13 13 3 5 6 2 9 0 6 -2 3 -5 -64 0 -9 0 9 0 -64 -64 733 29 -16 -9 12 -10 11 1 16 -6 -16 -64 0 7 16 0 -16 -64 0 -6 3 8 3 -64 0 -7 -3 7 -3 -64 -64 734 75 -16 -9 12 -13 13 10 3 10 4 9 5 8 5 7 4 6 2 4 -3 2 -6 0 -8 -2 -9 -6 -9 -8 -8 -9 -7 -10 -5 -10 -3 -9 -1 -8 0 -1 4 0 5 1 7 1 9 0 11 -2 12 -4 11 -5 9 -5 7 -4 4 -2 1 3 -6 5 -8 7 -9 9 -9 10 -8 10 -7 -64 -64 735 61 -16 -9 12 -11 11 -9 9 -8 7 -7 3 -7 -3 -8 -7 -9 -9 -64 0 9 9 8 7 7 3 7 -3 8 -7 9 -9 -64 0 -9 9 -7 8 -3 7 3 7 7 8 9 9 -64 0 -9 -9 -7 -8 -3 -7 3 -7 7 -8 9 -9 -64 -64 737 17 -16 -9 12 -7 7 -3 16 -3 -9 -64 0 3 16 3 -9 -64 -64 738 17 -16 -9 12 -12 12 0 16 0 -9 -64 0 -9 -9 9 -9 -64 -64 739 13 -16 -9 12 -12 12 9 16 -9 -9 9 -9 -64 -64 740 41 -16 -9 12 -13 13 0 9 -1 8 0 7 1 8 0 9 -64 0 -9 -7 -10 -8 -9 -9 -8 -8 -9 -7 -64 0 9 -7 8 -8 9 -9 10 -8 9 -7 -64 -64 741 71 -16 -9 12 -12 12 0 10 -4 6 -7 2 -8 -1 -8 -3 -7 -5 -5 -6 -3 -6 -1 -5 0 -3 -64 0 0 10 4 6 7 2 8 -1 8 -3 7 -5 5 -6 3 -6 1 -5 0 -3 -64 0 0 -3 -1 -7 -2 -10 -64 0 0 -3 1 -7 2 -10 -64 0 -2 -10 2 -10 -64 -64 742 57 -16 -9 12 -12 12 0 4 -1 7 -2 9 -4 10 -5 10 -7 9 -8 7 -8 3 -7 0 -6 -2 -4 -5 0 -10 -64 0 0 4 1 7 2 9 4 10 5 10 7 9 8 7 8 3 7 0 6 -2 4 -5 0 -10 -64 -64 743 45 -16 -9 12 -12 12 0 11 -2 8 -6 3 -9 0 -64 0 0 11 2 8 6 3 9 0 -64 0 -9 0 -6 -3 -2 -8 0 -11 -64 0 9 0 6 -3 2 -8 0 -11 -64 -64 744 101 -16 -9 12 -12 12 0 -2 2 -5 4 -6 6 -6 8 -5 9 -3 9 -1 8 1 6 2 4 2 1 1 -64 0 1 1 3 3 4 5 4 7 3 9 1 10 -1 10 -3 9 -4 7 -4 5 -3 3 -1 1 -64 0 -1 1 -4 2 -6 2 -8 1 -9 -1 -9 -3 -8 -5 -6 -6 -4 -6 -2 -5 0 -2 -64 0 0 -2 -1 -7 -2 -10 -64 0 0 -2 1 -7 2 -10 -64 0 -2 -10 2 -10 -64 -64 745 115 -16 -9 12 -12 12 0 0 0 -9 -1 -10 -64 0 0 -4 -1 -10 -64 0 0 9 -1 10 -3 10 -4 9 -4 7 -3 4 0 0 -64 0 0 9 1 10 3 10 4 9 4 7 3 4 0 0 -64 0 0 0 -4 3 -6 4 -8 4 -9 3 -9 1 -8 0 -64 0 0 0 4 3 6 4 8 4 9 3 9 1 8 0 -64 0 0 0 -4 -3 -6 -4 -8 -4 -9 -3 -9 -1 -8 0 -64 0 0 0 4 -3 6 -4 8 -4 9 -3 9 -1 8 0 -64 -64 746 115 -16 -9 12 -12 12 -9 -1 -8 -1 -6 -2 -5 -4 -5 -6 -6 -8 -64 0 -9 -1 -9 0 -8 1 -6 1 -5 0 -4 -2 -4 -5 -5 -7 -6 -8 -64 0 0 11 -2 9 -3 6 -3 3 -1 -3 -1 -6 -2 -8 0 -10 -64 0 0 11 2 9 3 6 3 3 1 -3 1 -6 2 -8 0 -10 -64 0 9 -1 9 0 8 1 6 1 5 0 4 -2 4 -5 5 -7 6 -8 -64 0 9 -1 8 -1 6 -2 5 -4 5 -6 6 -8 -64 0 -7 -4 7 -4 -64 -64 750 41 -16 -9 12 -2 1 1 0 0 -1 -1 -1 -2 0 -2 1 -1 2 0 2 1 1 1 -1 0 -3 -1 -4 -64 0 -1 1 -1 0 0 0 0 1 -1 1 -64 -64 751 37 -16 -9 12 -2 2 -1 2 -2 1 -2 -1 -1 -2 1 -2 2 -1 2 1 1 2 -1 2 -64 0 0 1 -1 0 0 -1 1 0 0 1 -64 -64 752 23 -16 -9 12 -4 4 -2 3 2 -3 -64 0 2 3 -2 -3 -64 0 -4 0 4 0 -64 -64 753 61 -16 -9 12 -5 5 0 7 -1 5 -3 2 -5 0 -64 0 0 7 1 5 3 2 5 0 -64 0 0 5 -3 1 -64 0 0 5 3 1 -64 0 0 3 -2 1 -64 0 0 3 2 1 -64 0 -1 1 1 1 -64 0 -5 0 5 0 -64 -64 754 57 -16 -9 12 -5 5 -5 0 -5 1 -4 3 -3 4 -1 5 1 5 3 4 4 3 5 1 5 0 -64 0 -2 4 2 4 -64 0 -3 3 3 3 -64 0 -4 2 4 2 -64 0 -4 1 4 1 -64 0 -5 0 5 0 -64 -64 755 33 -16 -9 12 -6 0 -6 12 -6 0 0 0 -6 12 -64 0 -6 9 -2 1 -64 0 -6 6 -3 0 -64 0 -6 3 -5 1 -64 -64 756 25 -16 -9 12 -5 5 0 7 -1 5 -3 2 -5 0 -64 0 0 7 1 5 3 2 5 0 -64 -64 757 27 -16 -9 12 -5 5 5 0 5 1 4 3 3 4 1 5 -1 5 -3 4 -4 3 -5 1 -5 0 -64 -64 758 31 -16 -9 12 -11 11 11 0 11 2 10 5 8 8 5 10 2 11 -2 11 -5 10 -8 8 -10 5 -11 2 -11 0 -64 -64 759 27 -16 -9 12 -5 5 -5 0 -5 -1 -4 -3 -3 -4 -1 -5 1 -5 3 -4 4 -3 5 -1 5 0 -64 -64 760 19 -16 -9 12 -6 6 -6 2 -4 0 -1 -1 1 -1 4 0 6 2 -64 -64 761 17 -16 -9 12 0 3 0 -3 2 -2 3 0 2 2 0 3 -64 -64 762 19 -16 -9 12 0 4 0 0 3 2 4 4 4 6 3 7 2 7 -64 -64 763 19 -16 -9 12 -4 0 0 0 -3 2 -4 4 -4 6 -3 7 -2 7 -64 -64 764 47 -16 -9 12 -5 5 5 10 4 11 2 12 -1 12 -3 11 -4 10 -5 8 -5 6 -4 4 -3 3 3 -1 4 -2 5 -4 5 -6 4 -8 3 -9 1 -10 -2 -10 -4 -9 -5 -8 -64 -64 765 47 -16 -9 12 -11 11 -9 -5 -10 -4 -11 -2 -11 1 -10 3 -9 4 -7 5 -5 5 -3 4 -2 3 2 -3 3 -4 5 -5 7 -5 9 -4 10 -3 11 -1 11 2 10 4 9 5 -64 -64 766 67 -16 -9 12 -11 11 0 0 2 -3 3 -4 5 -5 7 -5 9 -4 10 -3 11 -1 11 1 10 3 9 4 7 5 5 5 3 4 2 3 -2 -3 -3 -4 -5 -5 -7 -5 -9 -4 -10 -3 -11 -1 -11 1 -10 3 -9 4 -7 5 -5 5 -3 4 -2 3 0 0 -64 -64 767 49 -16 -9 12 -10 10 -7 12 -7 -9 -64 0 -10 12 9 12 -1 2 9 -8 -64 0 8 -4 9 -7 10 -9 -64 0 8 -4 8 -7 -64 0 5 -7 8 -7 -64 0 5 -7 8 -8 10 -9 -64 -64 768 65 -16 -9 12 -7 7 3 17 0 16 -2 15 -4 13 -6 10 -7 6 -7 0 -6 -3 -4 -5 -1 -6 1 -6 4 -5 6 -3 7 0 -64 0 -7 2 -6 5 -4 7 -1 8 1 8 4 7 6 5 7 2 7 -4 6 -8 4 -11 2 -13 0 -14 -3 -15 -64 -64 796 11 -16 -9 12 -20 20 -20 0 20 0 -64 -64 797 11 -16 -9 12 -14 14 -14 -14 14 14 -64 -64 798 11 -16 -9 12 0 0 0 20 0 -20 -64 -64 799 11 -16 -9 12 -14 14 -14 14 14 -14 -64 -64 800 11 -16 -9 12 -14 14 -14 0 14 0 -64 -64 801 11 -16 -9 12 -12 12 -12 -7 12 7 -64 -64 802 11 -16 -9 12 -7 7 -7 -12 7 12 -64 -64 803 11 -16 -9 12 0 0 0 14 0 -14 -64 -64 804 11 -16 -9 12 -7 7 -7 12 7 -12 -64 -64 805 11 -16 -9 12 -12 12 -12 7 12 -7 -64 -64 806 11 -16 -9 12 -7 7 -7 0 7 0 -64 -64 807 11 -16 -9 12 -5 5 -5 -5 5 5 -64 -64 808 11 -16 -9 12 0 0 0 7 0 -7 -64 -64 809 11 -16 -9 12 -5 5 -5 5 5 -5 -64 -64 810 21 -16 -9 12 -11 0 0 11 -2 11 -5 10 -8 8 -10 5 -11 2 -11 0 -64 -64 811 21 -16 -9 12 -11 0 -11 0 -11 -2 -10 -5 -8 -8 -5 -10 -2 -11 0 -11 -64 -64 812 21 -16 -9 12 0 11 0 -11 2 -11 5 -10 8 -8 10 -5 11 -2 11 0 -64 -64 813 21 -16 -9 12 0 11 11 0 11 2 10 5 8 8 5 10 2 11 0 11 -64 -64 814 23 -16 -9 12 -14 14 -14 3 -11 1 -7 -1 -2 -2 2 -2 7 -1 11 1 14 3 -64 -64 815 23 -16 -9 12 -2 3 3 14 1 11 -1 7 -2 2 -2 -2 -1 -7 1 -11 3 -14 -64 -64 816 23 -16 -9 12 -3 2 -3 14 -1 11 1 7 2 2 2 -2 1 -7 -1 -11 -3 -14 -64 -64 817 23 -16 -9 12 -14 14 -14 -3 -11 -1 -7 1 -2 2 2 2 7 1 11 -1 14 -3 -64 -64 818 15 -16 -9 12 -7 7 0 8 7 4 -7 -4 0 -8 -64 -64 819 15 -16 -9 12 -8 8 -8 0 -4 7 4 -7 8 0 -64 -64 820 15 -16 -9 12 -7 7 -7 -4 -7 4 7 -4 7 4 -64 -64 821 15 -16 -9 12 -8 8 -6 -6 -8 2 8 -2 6 6 -64 -64 822 51 -16 -9 12 -8 8 -8 -11 -6 -11 -3 -10 -1 -9 2 -6 3 -4 4 -1 4 3 3 6 2 8 1 9 -1 9 -2 8 -3 6 -4 3 -4 -1 -3 -4 -2 -6 1 -9 3 -10 6 -11 8 -11 -64 -64 823 51 -16 -9 12 -9 11 11 -8 11 -6 10 -3 9 -1 6 2 4 3 1 4 -3 4 -6 3 -8 2 -9 1 -9 -1 -8 -2 -6 -3 -3 -4 1 -4 4 -3 6 -2 9 1 10 3 11 6 11 8 -64 -64 824 51 -16 -9 12 -8 8 8 11 6 11 3 10 1 9 -2 6 -3 4 -4 1 -4 -3 -3 -6 -2 -8 -1 -9 1 -9 2 -8 3 -6 4 -3 4 1 3 4 2 6 -1 9 -3 10 -6 11 -8 11 -64 -64 825 51 -16 -9 12 -11 9 -11 8 -11 6 -10 3 -9 1 -6 -2 -4 -3 -1 -4 3 -4 6 -3 8 -2 9 -1 9 1 8 2 6 3 3 4 -1 4 -4 3 -6 2 -9 -1 -10 -3 -11 -6 -11 -8 -64 -64 826 47 -16 -9 12 -13 9 -13 2 -12 0 -10 -2 -8 -3 -5 -4 -1 -4 3 -3 6 -1 8 2 9 4 8 6 5 6 1 5 -1 4 -4 2 -6 -1 -7 -4 -7 -7 -6 -10 -5 -12 -64 -64 827 43 -16 -9 12 -13 7 -13 -2 -10 -4 -7 -5 -2 -5 1 -4 4 -2 6 1 7 4 7 6 6 7 4 7 1 6 -2 4 -4 1 -5 -2 -5 -7 -4 -10 -2 -13 -64 -64 828 57 -16 -9 12 -3 3 -1 3 -3 1 -3 -1 -1 -3 1 -3 3 -1 3 1 1 3 -1 3 -64 0 -1 2 -2 1 -2 -1 -1 -2 1 -2 2 -1 2 1 1 2 -1 2 -64 0 0 1 -1 0 0 -1 1 0 0 1 -64 -64 829 27 -16 -9 12 0 5 0 5 1 5 3 4 4 3 5 1 5 -1 4 -3 3 -4 1 -5 0 -5 -64 -64 830 23 -16 -9 12 -14 14 -14 0 -8 0 -64 0 -3 0 3 0 -64 0 8 0 14 0 -64 -64 831 15 -16 -9 12 -14 14 -14 -3 -14 3 14 3 14 -3 -64 -64 832 17 -16 -9 12 -8 8 0 14 -8 0 -64 0 0 14 8 0 -64 -64 833 23 -16 -9 12 -14 14 -14 0 14 0 -64 0 -8 -7 8 -7 -64 0 -2 -14 2 -14 -64 -64 834 23 -16 -9 12 -14 14 -14 0 14 0 -64 0 -14 0 0 -16 -64 0 14 0 0 -16 -64 -64 840 41 -16 -9 12 -7 7 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -1 7 1 6 4 4 6 1 7 -1 7 -64 -64 841 17 -16 -9 12 -6 6 -6 6 -6 -6 6 -6 6 6 -6 6 -64 -64 842 15 -16 -9 12 -7 7 0 8 -7 -4 7 -4 0 8 -64 -64 843 17 -16 -9 12 -6 6 0 10 -6 0 0 -10 6 0 0 10 -64 -64 844 29 -16 -9 12 -8 8 0 9 -2 3 -8 3 -3 -1 -5 -7 0 -3 5 -7 3 -1 8 3 2 3 0 9 -64 -64 845 17 -16 -9 12 -7 7 0 7 0 -7 -64 0 -7 0 7 0 -64 -64 846 17 -16 -9 12 -5 5 -5 5 5 -5 -64 0 5 5 -5 -5 -64 -64 847 23 -16 -9 12 -5 5 0 6 0 -6 -64 0 -5 3 5 -3 -64 0 5 3 -5 -3 -64 -64 850 75 -16 -9 12 -4 4 -1 4 -3 3 -4 1 -4 -1 -3 -3 -1 -4 1 -4 3 -3 4 -1 4 1 3 3 1 4 -1 4 -64 0 -3 1 -3 -1 -64 0 -2 2 -2 -2 -64 0 -1 3 -1 -3 -64 0 0 3 0 -3 -64 0 1 3 1 -3 -64 0 2 2 2 -2 -64 0 3 1 3 -1 -64 -64 851 59 -16 -9 12 -4 4 -4 4 -4 -4 4 -4 4 4 -4 4 -64 0 -3 3 -3 -3 -64 0 -2 3 -2 -3 -64 0 -1 3 -1 -3 -64 0 0 3 0 -3 -64 0 1 3 1 -3 -64 0 2 3 2 -3 -64 0 3 3 3 -3 -64 -64 852 39 -16 -9 12 -5 5 0 6 -5 -3 5 -3 0 6 -64 0 0 3 -3 -2 -64 0 0 3 3 -2 -64 0 0 0 -1 -2 -64 0 0 0 1 -2 -64 -64 853 39 -16 -9 12 -6 3 -6 0 3 -5 3 5 -6 0 -64 0 -3 0 2 -3 -64 0 -3 0 2 3 -64 0 0 0 2 -1 -64 0 0 0 2 1 -64 -64 854 39 -16 -9 12 -5 5 0 -6 5 3 -5 3 0 -6 -64 0 0 -3 3 2 -64 0 0 -3 -3 2 -64 0 0 0 1 2 -64 0 0 0 -1 2 -64 -64 855 39 -16 -9 12 -3 6 6 0 -3 5 -3 -5 6 0 -64 0 3 0 -2 3 -64 0 3 0 -2 -3 -64 0 0 0 -2 1 -64 0 0 0 -2 -1 -64 -64 856 49 -16 -9 12 -6 6 0 6 -4 -5 6 2 -6 2 4 -5 0 6 -64 0 0 0 0 6 -64 0 0 0 -6 2 -64 0 0 0 -4 -5 -64 0 0 0 4 -5 -64 0 0 0 6 2 -64 -64 857 27 -16 -9 12 0 7 0 7 0 -7 -64 0 0 7 7 4 0 1 -64 0 1 5 4 4 1 3 -64 -64 860 31 -16 -9 12 -5 5 0 6 0 -6 -64 0 -3 3 3 3 -64 0 -5 -3 -3 -5 -1 -6 1 -6 3 -5 5 -3 -64 -64 861 27 -16 -9 12 -6 6 0 6 0 -6 -64 0 -6 1 -5 3 5 3 6 1 -64 0 -2 -5 2 -5 -64 -64 862 33 -16 -9 12 -7 7 -5 4 5 -6 -64 0 5 4 -5 -6 -64 0 -3 6 -6 3 -7 1 -64 0 3 6 6 3 7 1 -64 -64 863 41 -16 -9 12 -9 9 -4 9 -9 -9 -64 0 4 9 9 -9 -64 0 -5 5 9 -9 -64 0 5 5 -9 -9 -64 0 -4 9 4 9 -64 0 -5 5 5 5 -64 -64 864 47 -16 -9 12 -9 9 0 11 0 -4 -64 0 -5 8 5 2 -64 0 5 8 -5 2 -64 0 -9 -4 -6 -10 -64 0 9 -4 6 -10 -64 0 -9 -4 9 -4 -64 0 -6 -10 6 -10 -64 -64 865 27 -16 -9 12 -11 9 -5 8 1 -4 -64 0 -7 2 1 6 -64 0 -11 -10 9 -10 9 0 -11 -10 -64 -64 866 33 -16 -9 12 -6 6 -2 6 -2 2 -6 2 -6 -2 -2 -2 -2 -6 2 -6 2 -2 6 -2 6 2 2 2 2 6 -2 6 -64 -64 867 69 -16 -9 12 -7 7 7 2 6 4 4 6 1 7 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -2 -64 0 7 2 5 4 3 5 1 5 -1 4 -2 3 -3 1 -3 -1 -2 -3 -1 -4 1 -5 3 -5 5 -4 7 -2 -64 -64 868 25 -16 -9 12 -7 7 0 8 -7 -4 7 -4 0 8 -64 0 0 -8 7 4 -7 4 0 -8 -64 -64 869 73 -16 -9 12 -11 11 -2 9 -2 11 -1 12 1 12 2 11 2 9 -64 0 -11 -8 -10 -6 -8 -4 -7 -2 -6 2 -6 7 -5 8 -3 9 3 9 5 8 6 7 6 2 7 -2 8 -4 10 -6 11 -8 -64 0 -11 -8 11 -8 -64 0 -1 -8 -2 -9 -1 -10 1 -10 2 -9 1 -8 -64 -64 870 133 -16 -9 12 -8 8 0 5 0 -1 -64 0 0 -1 -1 -10 -64 0 0 -1 1 -10 -64 0 -1 -10 1 -10 -64 0 0 5 -1 8 -2 10 -4 11 -64 0 -1 8 -4 11 -64 0 0 5 1 8 2 10 4 11 -64 0 1 8 4 11 -64 0 0 5 -4 7 -6 7 -8 5 -64 0 -2 6 -6 6 -8 5 -64 0 0 5 4 7 6 7 8 5 -64 0 2 6 6 6 8 5 -64 0 0 5 -2 4 -3 3 -3 0 -64 0 0 5 -2 3 -3 0 -64 0 0 5 2 4 3 3 3 0 -64 0 0 5 2 3 3 0 -64 -64 871 193 -16 -9 12 -8 8 0 9 0 7 -64 0 0 4 0 2 -64 0 0 -1 0 -3 -64 0 0 -7 -1 -10 -64 0 0 -7 1 -10 -64 0 -1 -10 1 -10 -64 0 0 11 -1 9 -2 8 -64 0 0 11 1 9 2 8 -64 0 -2 8 0 9 2 8 -64 0 0 7 -2 4 -4 3 -5 4 -64 0 0 7 2 4 4 3 5 4 -64 0 -4 3 -2 3 0 4 2 3 4 3 -64 0 0 2 -2 -1 -4 -2 -6 -2 -7 0 -7 -1 -6 -2 -64 0 0 2 2 -1 4 -2 6 -2 7 0 7 -1 6 -2 -64 0 -4 -2 -2 -2 0 -1 2 -2 4 -2 -64 0 0 -3 -2 -6 -3 -7 -5 -8 -6 -8 -7 -7 -8 -5 -8 -7 -6 -8 -64 0 0 -3 2 -6 3 -7 5 -8 6 -8 7 -7 8 -5 8 -7 6 -8 -64 0 -5 -8 -3 -8 0 -7 3 -8 5 -8 -64 -64 872 85 -16 -9 12 -8 8 0 -7 -1 -10 -64 0 0 -7 1 -10 -64 0 -1 -10 1 -10 -64 0 0 -7 3 -8 6 -8 8 -6 8 -3 7 -2 5 -2 7 0 8 3 7 5 5 6 3 5 4 8 3 10 1 11 -1 11 -3 10 -4 8 -3 5 -5 6 -7 5 -8 3 -7 0 -5 -2 -7 -2 -8 -3 -8 -6 -6 -8 -3 -8 0 -7 -64 -64 873 69 -16 -9 12 -8 8 0 -7 -1 -10 -64 0 0 -7 1 -10 -64 0 -1 -10 1 -10 -64 0 0 -7 4 -6 4 -4 6 -3 6 0 8 1 8 6 7 9 6 10 4 10 2 11 -2 11 -4 10 -6 10 -7 9 -8 6 -8 1 -6 0 -6 -3 -4 -4 -4 -6 0 -7 -64 -64 874 35 -16 -9 12 -9 9 -9 2 -7 0 -64 0 -6 7 -4 2 -64 0 0 11 0 3 -64 0 6 7 4 2 -64 0 9 2 7 0 -64 -64 899 17 -16 -9 12 -1 1 0 1 -1 0 0 -1 1 0 0 1 -64 -64 900 25 -16 -9 12 -2 2 -1 2 -2 1 -2 -1 -1 -2 1 -2 2 -1 2 1 1 2 -1 2 -64 -64 901 33 -16 -9 12 -4 4 -1 4 -3 3 -4 1 -4 -1 -3 -3 -1 -4 1 -4 3 -3 4 -1 4 1 3 3 1 4 -1 4 -64 -64 902 41 -16 -9 12 -5 5 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 -3 -4 -1 -5 1 -5 3 -4 4 -3 5 -1 5 1 4 3 3 4 1 5 -1 5 -64 -64 903 41 -16 -9 12 -7 7 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -1 7 1 6 4 4 6 1 7 -1 7 -64 -64 904 49 -16 -9 12 -11 11 -2 11 -5 10 -8 8 -10 5 -11 2 -11 -2 -10 -5 -8 -8 -5 -10 -2 -11 2 -11 5 -10 8 -8 10 -5 11 -2 11 2 10 5 8 8 5 10 2 11 -2 11 -64 -64 905 73 -16 -9 12 -17 17 -2 17 -6 16 -8 15 -11 13 -13 11 -15 8 -16 6 -17 2 -17 -2 -16 -6 -15 -8 -13 -11 -11 -13 -8 -15 -6 -16 -2 -17 2 -17 6 -16 8 -15 11 -13 13 -11 15 -8 16 -6 17 -2 17 2 16 6 15 8 13 11 11 13 8 15 6 16 2 17 -2 17 -64 -64 906 73 -16 -9 12 -22 22 -2 22 -7 21 -11 19 -14 17 -17 14 -19 11 -21 7 -22 2 -22 -2 -21 -7 -19 -11 -17 -14 -14 -17 -11 -19 -7 -21 -2 -22 2 -22 7 -21 11 -19 14 -17 17 -14 19 -11 21 -7 22 -2 22 2 21 7 19 11 17 14 14 17 11 19 7 21 2 22 -2 22 -64 -64 907 105 -16 -9 12 -41 41 -3 41 -9 40 -13 39 -18 37 -23 34 -27 31 -31 27 -34 23 -37 18 -39 13 -40 9 -41 3 -41 -3 -40 -9 -39 -13 -37 -18 -34 -23 -31 -27 -27 -31 -23 -34 -18 -37 -13 -39 -9 -40 -3 -41 3 -41 9 -40 13 -39 18 -37 23 -34 27 -31 31 -27 34 -23 37 -18 39 -13 40 -9 41 -3 41 3 40 9 39 13 37 18 34 23 31 27 27 31 23 34 18 37 13 39 9 40 3 41 -3 41 -64 -64 908 73 -16 -9 12 -20 20 0 17 -2 15 -5 14 -8 14 -11 15 -13 17 -20 10 -18 8 -17 5 -17 -8 -16 -11 -14 -13 -11 -14 -5 -14 -2 -15 0 -17 -64 0 0 17 2 15 5 14 8 14 11 15 13 17 20 10 18 8 17 5 17 -8 16 -11 14 -13 11 -14 5 -14 2 -15 0 -17 -64 -64 909 71 -16 -9 12 -17 17 0 17 -2 15 -5 14 -8 14 -11 15 -13 17 -16 11 -17 7 -17 2 -16 -2 -14 -6 -11 -10 -6 -14 0 -17 -64 0 0 17 2 15 5 14 8 14 11 15 13 17 16 11 17 7 17 2 16 -2 14 -6 11 -10 6 -14 0 -17 -64 0 -16 10 16 10 -64 -64 910 67 -16 -9 12 -10 9 5 2 4 1 5 0 6 1 6 2 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 -6 -16 6 12 -64 -64 1001 41 -10 -6 7 -7 7 0 7 -5 -6 -64 0 0 4 4 -6 -64 0 0 7 5 -6 -64 0 -3 -2 2 -2 -64 0 -7 -6 -2 -6 -64 0 2 -6 7 -6 -64 -64 1002 75 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 4 2 1 1 -64 0 1 7 3 6 4 4 3 2 1 1 -64 0 -3 1 1 1 4 0 5 -2 5 -3 4 -5 1 -6 -6 -6 -64 0 1 1 3 0 4 -2 4 -3 3 -5 1 -6 -64 -64 1003 53 -10 -6 7 -7 7 4 6 5 7 5 3 4 6 2 7 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 5 -3 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 -64 1004 57 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 5 6 2 6 -1 5 -4 4 -5 1 -6 -6 -6 -64 0 1 7 3 6 4 5 5 2 5 -1 4 -4 3 -5 1 -6 -64 -64 1005 49 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 1 3 1 -1 -64 0 -6 7 4 7 4 3 3 7 -64 0 -3 1 1 1 -64 0 -6 -6 4 -6 4 -2 3 -6 -64 -64 1006 45 -10 -6 7 -8 6 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 1 3 1 -1 -64 0 -6 7 4 7 4 3 3 7 -64 0 -3 1 1 1 -64 0 -6 -6 -1 -6 -64 -64 1007 77 -10 -6 7 -7 9 4 6 5 7 5 3 4 6 2 7 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 0 2 -6 3 -5 4 -3 -64 0 4 -1 4 -6 -64 0 5 -1 5 -6 -64 0 2 -1 7 -1 -64 -64 1008 59 -10 -6 7 -8 9 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 4 7 4 -6 -64 0 5 7 5 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -3 1 4 1 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1009 29 -10 -6 7 -4 5 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -2 7 3 7 -64 0 -2 -6 3 -6 -64 -64 1010 43 -10 -6 7 -6 6 1 7 1 -3 0 -5 -1 -6 -64 0 2 7 2 -3 1 -5 -1 -6 -2 -6 -4 -5 -5 -3 -4 -2 -3 -3 -4 -4 -64 0 -1 7 4 7 -64 -64 1011 59 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 5 7 -3 -1 -64 0 -1 1 4 -6 -64 0 0 1 5 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1012 33 -10 -6 7 -7 6 -3 7 -3 -6 -64 0 -2 7 -2 -6 -64 0 -5 7 0 7 -64 0 -5 -6 5 -6 5 -2 4 -6 -64 -64 1013 65 -10 -6 7 -9 10 -5 7 -5 -6 -64 0 -4 4 0 -6 -64 0 -4 7 0 -3 -64 0 5 7 0 -6 -64 0 5 7 5 -6 -64 0 6 7 6 -6 -64 0 -7 7 -4 7 -64 0 5 7 8 7 -64 0 -7 -6 -3 -6 -64 0 3 -6 8 -6 -64 -64 1014 47 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 5 4 -6 -64 0 -3 7 4 -4 -64 0 4 7 4 -6 -64 0 -6 7 -3 7 -64 0 2 7 6 7 -64 0 -6 -6 -2 -6 -64 -64 1015 69 -10 -6 7 -7 8 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 5 -4 6 -1 6 2 5 5 4 6 2 7 -1 7 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 0 2 -6 4 -4 5 -1 5 2 4 5 2 7 -64 -64 1016 55 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 5 3 4 1 1 0 -3 0 -64 0 1 7 3 6 4 4 4 3 3 1 1 0 -64 0 -6 -6 -1 -6 -64 -64 1017 99 -10 -6 7 -7 8 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 5 -4 6 -1 6 2 5 5 4 6 2 7 -1 7 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 0 2 -6 4 -4 5 -1 5 2 4 5 2 7 -64 0 -2 -5 -2 -3 -1 -2 1 -2 2 -3 3 -8 4 -9 5 -9 6 -8 -64 0 2 -3 3 -6 4 -8 5 -9 -64 -64 1018 79 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 5 3 4 1 1 0 -3 0 -64 0 1 7 3 6 4 4 4 3 3 1 1 0 -64 0 -6 -6 -1 -6 -64 0 1 0 2 -1 3 -5 4 -6 5 -6 6 -5 -64 0 1 0 3 -1 4 -5 5 -6 -64 -64 1019 69 -10 -6 7 -7 8 4 5 5 7 5 3 4 5 3 6 1 7 -1 7 -3 6 -4 5 -4 3 -3 2 -1 1 2 0 4 -1 5 -2 -64 0 -4 4 -3 3 -1 2 2 1 4 0 5 -1 5 -4 4 -5 2 -6 0 -6 -2 -5 -3 -4 -4 -2 -4 -6 -3 -4 -64 -64 1020 37 -10 -6 7 -7 8 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -4 7 -5 3 -5 7 6 7 6 3 5 7 -64 0 -2 -6 3 -6 -64 -64 1021 45 -10 -6 7 -8 9 -4 7 -4 -3 -3 -5 -1 -6 2 -6 4 -5 5 -3 5 7 -64 0 -3 7 -3 -3 -2 -5 -1 -6 -64 0 -6 7 -1 7 -64 0 3 7 7 7 -64 -64 1022 35 -10 -6 7 -7 7 -5 7 0 -6 -64 0 -4 7 0 -3 -64 0 5 7 0 -6 -64 0 -7 7 -2 7 -64 0 2 7 7 7 -64 -64 1023 53 -10 -6 7 -9 9 -6 7 -3 -6 -64 0 -5 7 -3 -2 -64 0 0 7 -3 -6 -64 0 0 7 3 -6 -64 0 1 7 3 -2 -64 0 6 7 3 -6 -64 0 -8 7 -3 7 -64 0 4 7 8 7 -64 -64 1024 47 -10 -6 7 -7 8 -4 7 4 -6 -64 0 -3 7 5 -6 -64 0 5 7 -4 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1025 45 -10 -6 7 -6 7 -4 7 0 0 0 -6 -64 0 -3 7 1 0 -64 0 5 7 1 0 1 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -2 -6 3 -6 -64 -64 1026 37 -10 -6 7 -6 7 4 7 -4 -6 -64 0 5 7 -3 -6 -64 0 -3 7 -4 3 -4 7 5 7 -64 0 -4 -6 5 -6 5 -2 4 -6 -64 -64 1027 41 -10 -6 7 -7 7 0 7 -5 -6 -64 0 0 4 4 -6 -64 0 0 7 5 -6 -64 0 -3 -2 2 -2 -64 0 -7 -6 -2 -6 -64 0 2 -6 7 -6 -64 -64 1028 75 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 4 2 1 1 -64 0 1 7 3 6 4 4 3 2 1 1 -64 0 -3 1 1 1 4 0 5 -2 5 -3 4 -5 1 -6 -6 -6 -64 0 1 1 3 0 4 -2 4 -3 3 -5 1 -6 -64 -64 1029 33 -10 -6 7 -7 6 -3 7 -3 -6 -64 0 -2 7 -2 -6 -64 0 -5 7 5 7 5 3 4 7 -64 0 -5 -6 0 -6 -64 -64 1030 35 -10 -6 7 -7 7 0 7 -6 -6 -64 0 0 5 5 -6 -64 0 0 7 6 -6 -64 0 -5 -5 4 -5 -64 0 -6 -6 6 -6 -64 -64 1031 49 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 1 3 1 -1 -64 0 -6 7 4 7 4 3 3 7 -64 0 -3 1 1 1 -64 0 -6 -6 4 -6 4 -2 3 -6 -64 -64 1032 37 -10 -6 7 -6 7 4 7 -4 -6 -64 0 5 7 -3 -6 -64 0 -3 7 -4 3 -4 7 5 7 -64 0 -4 -6 5 -6 5 -2 4 -6 -64 -64 1033 59 -10 -6 7 -8 9 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 4 7 4 -6 -64 0 5 7 5 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -3 1 4 1 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1034 93 -10 -6 7 -7 8 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 5 -4 6 -1 6 2 5 5 4 6 2 7 -1 7 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 0 2 -6 4 -4 5 -1 5 2 4 5 2 7 -64 0 -1 3 -1 -2 -64 0 2 3 2 -2 -64 0 -1 1 2 1 -64 0 -1 0 2 0 -64 -64 1035 29 -10 -6 7 -4 5 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -2 7 3 7 -64 0 -2 -6 3 -6 -64 -64 1036 59 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 5 7 -3 -1 -64 0 -1 1 4 -6 -64 0 0 1 5 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1037 35 -10 -6 7 -7 7 0 7 -5 -6 -64 0 0 4 4 -6 -64 0 0 7 5 -6 -64 0 -7 -6 -2 -6 -64 0 2 -6 7 -6 -64 -64 1038 65 -10 -6 7 -9 10 -5 7 -5 -6 -64 0 -4 4 0 -6 -64 0 -4 7 0 -3 -64 0 5 7 0 -6 -64 0 5 7 5 -6 -64 0 6 7 6 -6 -64 0 -7 7 -4 7 -64 0 5 7 8 7 -64 0 -7 -6 -3 -6 -64 0 3 -6 8 -6 -64 -64 1039 47 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 5 4 -6 -64 0 -3 7 4 -4 -64 0 4 7 4 -6 -64 0 -6 7 -3 7 -64 0 2 7 6 7 -64 0 -6 -6 -2 -6 -64 -64 1040 77 -10 -6 7 -8 8 -5 8 -6 5 -64 0 6 8 5 5 -64 0 -2 2 -3 -1 -64 0 3 2 2 -1 -64 0 -5 -4 -6 -7 -64 0 6 -4 5 -7 -64 0 -5 7 5 7 -64 0 -5 6 5 6 -64 0 -2 1 2 1 -64 0 -2 0 2 0 -64 0 -5 -5 5 -5 -64 0 -5 -6 5 -6 -64 -64 1041 69 -10 -6 7 -7 8 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -4 -3 -5 -1 -6 2 -6 4 -5 5 -4 6 -1 6 2 5 5 4 6 2 7 -1 7 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -4 -1 -6 -64 0 2 -6 4 -4 5 -1 5 2 4 5 2 7 -64 -64 1042 47 -10 -6 7 -8 9 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 4 7 4 -6 -64 0 5 7 5 -6 -64 0 -6 7 7 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1043 55 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 5 3 4 1 1 0 -3 0 -64 0 1 7 3 6 4 4 4 3 3 1 1 0 -64 0 -6 -6 -1 -6 -64 -64 1044 45 -10 -6 7 -7 9 -5 7 0 1 -64 0 -4 7 1 1 -5 -6 -64 0 -5 7 5 7 6 3 4 7 -64 0 -4 -5 5 -5 -64 0 -5 -6 5 -6 6 -2 4 -6 -64 -64 1045 37 -10 -6 7 -7 8 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -4 7 -5 3 -5 7 6 7 6 3 5 7 -64 0 -2 -6 3 -6 -64 -64 1046 71 -10 -6 7 -7 8 -5 3 -4 6 -3 7 -2 7 -1 6 0 3 0 -6 -64 0 6 3 5 6 4 7 3 7 2 6 1 3 1 -6 -64 0 -5 3 -4 5 -3 6 -2 6 -1 5 0 3 -64 0 6 3 5 5 4 6 3 6 2 5 1 3 -64 0 -2 -6 3 -6 -64 -64 1047 85 -10 -6 7 -7 8 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -1 4 -4 3 -5 1 -5 0 -4 -2 -1 -3 2 -3 5 -2 6 0 6 1 5 3 2 4 -1 4 -64 0 -1 4 -3 3 -4 1 -4 0 -3 -2 -1 -3 -64 0 2 -3 4 -2 5 0 5 1 4 3 2 4 -64 0 -2 7 3 7 -64 0 -2 -6 3 -6 -64 -64 1048 47 -10 -6 7 -7 8 -4 7 4 -6 -64 0 -3 7 5 -6 -64 0 5 7 -4 -6 -64 0 -6 7 -1 7 -64 0 2 7 7 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1049 71 -10 -6 7 -8 9 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -6 2 -5 3 -4 3 -3 -1 -1 -3 -64 0 2 -3 4 -1 5 3 6 3 7 2 -64 0 -5 3 -4 0 -3 -2 -1 -3 2 -3 4 -2 5 0 6 3 -64 0 -2 7 3 7 -64 0 -2 -6 3 -6 -64 -64 1050 75 -10 -6 7 -7 8 -5 -4 -4 -6 -1 -6 -5 0 -5 3 -4 5 -3 6 -1 7 2 7 4 6 5 5 6 3 6 0 2 -6 5 -6 6 -4 -64 0 -3 -3 -4 0 -4 3 -3 5 -1 7 -64 0 2 7 4 5 5 3 5 0 4 -3 -64 0 -4 -5 -2 -5 -64 0 3 -5 5 -5 -64 -64 1051 41 -10 -6 7 -7 7 2 7 -7 -6 -64 0 1 5 2 -6 -64 0 2 7 3 -6 -64 0 -4 -2 2 -2 -64 0 -9 -6 -4 -6 -64 0 0 -6 5 -6 -64 -64 1052 73 -10 -6 7 -8 7 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 -4 7 3 7 5 6 5 4 4 2 1 1 -64 0 3 7 4 6 4 4 3 2 1 1 -64 0 -3 1 0 1 2 0 3 -1 3 -3 2 -5 -1 -6 -8 -6 -64 0 0 1 2 -1 2 -3 1 -5 -1 -6 -64 -64 1053 55 -10 -6 7 -7 6 4 6 5 6 6 7 5 4 4 6 2 7 0 7 -2 6 -3 5 -4 3 -5 0 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -3 -64 0 0 7 -2 5 -3 3 -4 0 -4 -4 -2 -6 -64 -64 1054 57 -10 -6 7 -8 7 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 -4 7 2 7 4 6 5 4 5 1 4 -2 3 -4 2 -5 -1 -6 -8 -6 -64 0 2 7 3 6 4 4 4 1 3 -2 2 -4 1 -5 -1 -6 -64 -64 1055 49 -10 -6 7 -8 7 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 1 3 0 -1 -64 0 -4 7 6 7 5 4 5 7 -64 0 -3 1 0 1 -64 0 -8 -6 2 -6 3 -3 1 -6 -64 -64 1056 45 -10 -6 7 -8 6 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 1 3 0 -1 -64 0 -4 7 6 7 5 4 5 7 -64 0 -3 1 0 1 -64 0 -8 -6 -3 -6 -64 -64 1057 71 -10 -6 7 -7 7 4 6 5 6 6 7 5 4 4 6 2 7 0 7 -2 6 -3 5 -4 3 -5 0 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -1 -64 0 0 7 -2 5 -3 3 -4 0 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -1 -64 0 1 -1 6 -1 -64 -64 1058 59 -10 -6 7 -8 9 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 6 7 2 -6 -64 0 7 7 3 -6 -64 0 -4 7 1 7 -64 0 4 7 9 7 -64 0 -3 1 4 1 -64 0 -8 -6 -3 -6 -64 0 0 -6 5 -6 -64 -64 1059 29 -10 -6 7 -4 5 2 7 -2 -6 -64 0 3 7 -1 -6 -64 0 0 7 5 7 -64 0 -4 -6 1 -6 -64 -64 1060 43 -10 -6 7 -6 6 3 7 0 -3 -1 -5 -2 -6 -64 0 4 7 1 -3 0 -5 -2 -6 -3 -6 -5 -5 -6 -3 -5 -2 -4 -3 -5 -4 -64 0 1 7 6 7 -64 -64 1061 59 -10 -6 7 -8 8 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 7 7 -3 0 -64 0 0 2 2 -6 -64 0 1 2 3 -6 -64 0 -4 7 1 7 -64 0 4 7 9 7 -64 0 -8 -6 -3 -6 -64 0 0 -6 5 -6 -64 -64 1062 33 -10 -6 7 -7 6 -1 7 -5 -6 -64 0 0 7 -4 -6 -64 0 -3 7 2 7 -64 0 -7 -6 3 -6 4 -3 2 -6 -64 -64 1063 65 -10 -6 7 -9 10 -3 7 -7 -6 -64 0 -3 5 -2 -6 -64 0 -2 7 -1 -4 -64 0 7 7 -2 -6 -64 0 7 7 3 -6 -64 0 8 7 4 -6 -64 0 -5 7 -2 7 -64 0 7 7 10 7 -64 0 -9 -6 -5 -6 -64 0 1 -6 6 -6 -64 -64 1064 47 -10 -6 7 -8 8 -2 7 -6 -6 -64 0 -2 7 2 -6 -64 0 -1 7 2 -3 -64 0 6 7 2 -6 -64 0 -4 7 -1 7 -64 0 4 7 8 7 -64 0 -8 -6 -4 -6 -64 -64 1065 69 -10 -6 7 -7 7 0 7 -2 6 -3 5 -4 3 -5 0 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 5 1 5 4 4 6 2 7 0 7 -64 0 0 7 -2 5 -3 3 -4 0 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 4 1 4 5 2 7 -64 -64 1066 53 -10 -6 7 -8 7 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 -4 7 3 7 5 6 6 5 6 3 5 1 2 0 -3 0 -64 0 3 7 5 5 5 3 4 1 2 0 -64 0 -8 -6 -3 -6 -64 -64 1067 97 -10 -6 7 -7 7 0 7 -2 6 -3 5 -4 3 -5 0 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 5 1 5 4 4 6 2 7 0 7 -64 0 0 7 -2 5 -3 3 -4 0 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 4 1 4 5 2 7 -64 0 -3 -5 -3 -4 -2 -3 -1 -3 0 -4 0 -8 1 -9 2 -9 3 -8 -64 0 0 -4 1 -8 2 -9 -64 -64 1068 75 -10 -6 7 -8 8 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 -4 7 3 7 5 6 6 5 6 3 5 1 2 0 -3 0 -64 0 3 7 5 5 5 3 4 1 2 0 -64 0 1 0 2 -5 3 -6 4 -6 5 -5 -64 0 1 0 2 -1 3 -5 4 -6 -64 0 -8 -6 -3 -6 -64 -64 1069 61 -10 -6 7 -7 8 5 6 6 6 7 7 6 4 5 6 3 7 0 7 -2 6 -3 5 -3 3 -2 2 3 -1 4 -2 -64 0 -3 4 -2 3 3 0 4 -1 4 -4 3 -5 1 -6 -2 -6 -4 -5 -5 -3 -6 -6 -5 -5 -4 -5 -64 -64 1070 37 -10 -6 7 -7 8 2 7 -2 -6 -64 0 3 7 -1 -6 -64 0 -2 7 -4 4 -3 7 8 7 7 4 7 7 -64 0 -4 -6 1 -6 -64 -64 1071 45 -10 -6 7 -8 9 -2 7 -5 -3 -5 -5 -3 -6 1 -6 3 -5 4 -3 7 7 -64 0 -1 7 -4 -3 -4 -5 -3 -6 -64 0 -4 7 1 7 -64 0 5 7 9 7 -64 -64 1072 35 -10 -6 7 -7 7 -3 7 -2 -6 -64 0 -2 7 -1 -4 -64 0 7 7 -2 -6 -64 0 -5 7 0 7 -64 0 4 7 9 7 -64 -64 1073 53 -10 -6 7 -9 9 -4 7 -5 -6 -64 0 -3 7 -4 -4 -64 0 2 7 -5 -6 -64 0 2 7 1 -6 -64 0 3 7 2 -4 -64 0 8 7 1 -6 -64 0 -6 7 -1 7 -64 0 6 7 10 7 -64 -64 1074 47 -10 -6 7 -7 8 -2 7 2 -6 -64 0 -1 7 3 -6 -64 0 7 7 -6 -6 -64 0 -4 7 1 7 -64 0 4 7 9 7 -64 0 -8 -6 -3 -6 -64 0 0 -6 5 -6 -64 -64 1075 45 -10 -6 7 -6 7 -2 7 0 1 -2 -6 -64 0 -1 7 1 1 -64 0 7 7 1 1 -1 -6 -64 0 -4 7 1 7 -64 0 4 7 9 7 -64 0 -4 -6 1 -6 -64 -64 1076 37 -10 -6 7 -6 7 6 7 -6 -6 -64 0 7 7 -5 -6 -64 0 -1 7 -3 4 -2 7 7 7 -64 0 -6 -6 3 -6 4 -3 2 -6 -64 -64 1101 69 -10 -6 7 -6 8 -1 3 -2 2 -2 1 -3 1 -3 2 -1 3 2 3 4 1 4 -5 5 -6 6 -6 -64 0 2 3 3 1 3 -5 5 -6 -64 0 3 0 0 -1 -2 -2 -3 -3 -3 -5 -2 -6 1 -6 2 -5 3 -3 -64 0 0 -1 -2 -3 -2 -5 -1 -6 -64 -64 1102 63 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -3 0 -2 2 0 3 2 3 4 2 5 0 5 -3 4 -5 2 -6 0 -6 -2 -5 -3 -3 -64 0 2 3 3 2 4 0 4 -3 3 -5 2 -6 -64 0 -6 7 -3 7 -64 -64 1103 53 -10 -6 7 -6 6 4 1 3 1 3 0 4 0 4 1 3 2 1 3 -1 3 -3 2 -4 0 -4 -3 -3 -5 -1 -6 1 -6 3 -5 4 -4 -64 0 -1 3 -2 2 -3 0 -3 -3 -2 -5 -1 -6 -64 -64 1104 69 -10 -6 7 -6 9 4 7 4 -6 -64 0 5 7 5 -6 -64 0 4 0 3 2 1 3 -1 3 -3 2 -4 0 -4 -3 -3 -5 -1 -6 1 -6 3 -5 4 -3 -64 0 -1 3 -2 2 -3 0 -3 -3 -2 -5 -1 -6 -64 0 2 7 5 7 -64 0 4 -6 7 -6 -64 -64 1105 57 -10 -6 7 -6 6 -3 -1 4 -1 4 0 3 2 1 3 -1 3 -3 2 -4 0 -4 -3 -3 -5 -1 -6 1 -6 3 -5 4 -4 -64 0 3 -1 3 1 1 3 -64 0 -1 3 -2 2 -3 0 -3 -3 -2 -5 -1 -6 -64 -64 1106 45 -10 -6 7 -6 5 2 7 3 6 3 5 4 5 4 6 2 7 0 7 -2 5 -2 -6 -64 0 0 7 -1 5 -1 -6 -64 0 -4 3 1 3 -64 0 -4 -6 1 -6 -64 -64 1107 89 -10 -6 7 -6 7 -1 3 -3 1 -3 -1 -1 -3 1 -3 3 -1 3 1 1 3 -1 3 -64 0 -1 3 -2 1 -2 -1 -1 -3 -64 0 1 -3 2 -1 2 1 1 3 -64 0 2 2 3 3 4 3 -64 0 -2 -2 -3 -3 -3 -6 -2 -7 2 -7 4 -8 -64 0 -3 -5 -2 -6 2 -6 4 -7 4 -9 2 -10 -2 -10 -4 -9 -4 -7 -2 -6 -64 -64 1108 61 -10 -6 7 -8 9 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -3 0 -2 2 0 3 2 3 4 2 5 0 5 -6 -64 0 2 3 3 2 4 0 4 -6 -64 0 -6 7 -3 7 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1109 41 -10 -6 7 -4 5 0 7 0 6 1 6 1 7 0 7 -64 0 0 3 0 -6 -64 0 1 3 1 -6 -64 0 -2 3 1 3 -64 0 -2 -6 3 -6 -64 -64 1110 51 -10 -6 7 -4 5 1 7 1 6 2 6 2 7 1 7 -64 0 1 3 1 -8 0 -10 -64 0 2 3 2 -8 0 -10 -2 -10 -3 -9 -3 -8 -2 -8 -2 -9 -3 -9 -64 0 -1 3 2 3 -64 -64 1111 59 -10 -6 7 -8 8 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 5 3 -3 -3 -64 0 0 -1 4 -6 -64 0 1 -1 5 -6 -64 0 -6 7 -3 7 -64 0 2 3 7 3 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1112 29 -10 -6 7 -4 5 0 7 0 -6 -64 0 1 7 1 -6 -64 0 -2 7 1 7 -64 0 -2 -6 3 -6 -64 -64 1113 93 -10 -6 7 -12 13 -8 3 -8 -6 -64 0 -7 3 -7 -6 -64 0 -7 0 -6 2 -4 3 -2 3 0 2 1 0 1 -6 -64 0 -2 3 -1 2 0 0 0 -6 -64 0 1 0 2 2 4 3 6 3 8 2 9 0 9 -6 -64 0 6 3 7 2 8 0 8 -6 -64 0 -10 3 -7 3 -64 0 -10 -6 -5 -6 -64 0 -2 -6 3 -6 -64 0 6 -6 11 -6 -64 -64 1114 61 -10 -6 7 -8 9 -4 3 -4 -6 -64 0 -3 3 -3 -6 -64 0 -3 0 -2 2 0 3 2 3 4 2 5 0 5 -6 -64 0 2 3 3 2 4 0 4 -6 -64 0 -6 3 -3 3 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1115 61 -10 -6 7 -6 7 -1 3 -3 2 -4 0 -4 -3 -3 -5 -1 -6 2 -6 4 -5 5 -3 5 0 4 2 2 3 -1 3 -64 0 -1 3 -2 2 -3 0 -3 -3 -2 -5 -1 -6 -64 0 2 -6 3 -5 4 -3 4 0 3 2 2 3 -64 -64 1116 69 -10 -6 7 -8 7 -4 3 -4 -10 -64 0 -3 3 -3 -10 -64 0 -3 0 -2 2 0 3 2 3 4 2 5 0 5 -3 4 -5 2 -6 0 -6 -2 -5 -3 -3 -64 0 2 3 3 2 4 0 4 -3 3 -5 2 -6 -64 0 -6 3 -3 3 -64 0 -6 -10 -1 -10 -64 -64 1117 63 -10 -6 7 -7 7 3 3 3 -10 -64 0 4 3 4 -10 -64 0 3 0 2 2 0 3 -2 3 -4 2 -5 0 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -3 -64 0 -2 3 -3 2 -4 0 -4 -3 -3 -5 -2 -6 -64 0 1 -10 6 -10 -64 -64 1118 49 -10 -6 7 -7 6 -3 3 -3 -6 -64 0 -2 3 -2 -6 -64 0 -2 0 -1 2 1 3 3 3 4 2 4 1 3 1 3 2 4 2 -64 0 -5 3 -2 3 -64 0 -5 -6 0 -6 -64 -64 1119 57 -10 -6 7 -6 7 2 3 3 2 3 1 4 1 4 2 2 3 -1 3 -3 2 -3 0 -1 -1 2 -2 4 -3 -64 0 -3 1 -1 0 2 -1 4 -2 4 -5 2 -6 -1 -6 -3 -5 -3 -4 -2 -4 -2 -5 -1 -6 -64 -64 1120 33 -10 -6 7 -6 5 -2 7 -2 -4 0 -6 2 -6 3 -5 3 -4 -64 0 -1 7 -1 -4 0 -6 -64 0 -4 3 2 3 -64 -64 1121 61 -10 -6 7 -8 9 -4 3 -4 -3 -3 -5 -1 -6 1 -6 3 -5 4 -3 -64 0 -3 3 -3 -3 -2 -5 -1 -6 -64 0 4 3 4 -6 -64 0 5 3 5 -6 -64 0 -6 3 -3 3 -64 0 2 3 5 3 -64 0 4 -6 7 -6 -64 -64 1122 35 -10 -6 7 -7 7 -4 3 0 -6 -64 0 -3 3 0 -4 -64 0 4 3 0 -6 -64 0 -6 3 -1 3 -64 0 2 3 6 3 -64 -64 1123 53 -10 -6 7 -9 9 -6 3 -3 -6 -64 0 -5 3 -3 -3 -64 0 0 3 -3 -6 -64 0 0 3 3 -6 -64 0 1 3 3 -3 -64 0 6 3 3 -6 -64 0 -8 3 -3 3 -64 0 4 3 8 3 -64 -64 1124 47 -10 -6 7 -7 7 -4 3 3 -6 -64 0 -3 3 4 -6 -64 0 4 3 -4 -6 -64 0 -6 3 -1 3 -64 0 2 3 6 3 -64 0 -6 -6 -2 -6 -64 0 1 -6 6 -6 -64 -64 1125 51 -10 -6 7 -7 7 -4 3 0 -6 -64 0 -3 3 0 -4 -64 0 4 3 0 -6 -2 -9 -4 -10 -5 -10 -6 -9 -6 -8 -5 -8 -5 -9 -6 -9 -64 0 -6 3 -1 3 -64 0 2 3 6 3 -64 -64 1126 37 -10 -6 7 -6 6 3 3 -4 -6 -64 0 4 3 -3 -6 -64 0 -3 3 -4 1 -4 3 4 3 -64 0 -4 -6 4 -6 4 -4 3 -6 -64 -64 1127 69 -10 -6 7 -7 9 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 -1 -6 1 -5 3 -3 5 0 6 3 -64 0 -1 3 -3 1 -4 -1 -4 -3 -3 -5 -2 -6 -64 0 -1 3 1 3 3 2 5 -5 6 -6 -64 0 1 3 2 2 4 -5 6 -6 7 -6 -64 -64 1128 85 -10 -6 7 -7 6 0 7 -2 5 -3 3 -5 -3 -7 -10 -64 0 -1 6 -2 4 -4 -2 -6 -10 -64 0 0 7 2 7 4 6 4 4 3 2 0 1 -64 0 2 7 3 6 3 4 2 2 0 1 -64 0 0 1 2 0 3 -2 3 -4 2 -5 0 -6 -1 -6 -3 -5 -4 -2 -64 0 0 1 1 0 2 -2 2 -4 0 -6 -64 -64 1129 43 -10 -6 7 -7 7 -6 1 -4 3 -2 3 0 2 1 -1 1 -6 0 -10 -64 0 -6 1 -4 2 -2 2 0 1 1 -1 -64 0 5 3 4 0 1 -6 -1 -10 -64 -64 1130 83 -10 -6 7 -7 7 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 4 0 3 2 0 4 -1 6 -1 7 0 8 2 8 3 7 4 5 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 3 1 1 3 -64 0 -1 6 0 7 2 7 4 5 -64 -64 1131 59 -10 -6 7 -6 6 4 2 2 3 -1 3 -3 2 -3 1 -2 0 0 -1 -64 0 -1 3 -2 2 -2 1 0 -1 -64 0 0 -1 -3 -2 -4 -3 -4 -5 -2 -6 1 -6 3 -5 -64 0 0 -1 -2 -2 -3 -3 -3 -5 -2 -6 -64 -64 1132 61 -10 -6 7 -6 5 0 7 -1 6 -1 5 1 4 4 4 4 5 1 4 -2 3 -3 2 -4 0 -4 -2 -3 -4 -2 -5 0 -6 1 -7 1 -9 0 -10 -2 -10 -3 -9 -64 0 1 4 -1 3 -2 2 -3 0 -3 -2 -2 -4 0 -6 -64 -64 1133 57 -10 -6 7 -9 7 -8 0 -7 2 -6 3 -4 3 -3 2 -3 1 -5 -6 -64 0 -5 3 -4 2 -4 1 -6 -6 -64 0 -3 1 -2 2 0 3 2 3 4 2 4 0 1 -10 -64 0 2 3 3 2 3 0 0 -10 -64 -64 1134 75 -10 -6 7 -9 7 -8 -1 -7 1 -6 2 -4 2 -3 1 -3 -4 -2 -6 -64 0 -5 2 -4 1 -4 -3 -3 -5 -2 -6 -1 -6 1 -5 2 -4 3 -2 4 1 4 4 3 6 2 7 0 7 -1 6 -1 4 0 2 3 0 5 -1 -64 0 -1 -6 1 -4 2 -2 3 1 3 4 2 7 -64 -64 1135 31 -10 -6 7 -4 5 0 3 -2 -4 -2 -5 -1 -6 1 -6 3 -5 4 -3 -64 0 1 3 -1 -4 -1 -5 0 -6 -64 -64 1136 57 -10 -6 7 -7 7 -3 3 -6 -6 -64 0 -2 3 -5 -6 -64 0 3 3 4 2 5 2 4 3 2 3 0 1 -3 0 -64 0 -3 0 -2 -1 0 -5 2 -6 4 -5 5 -3 -64 0 -3 0 -1 -1 1 -5 2 -6 -64 -64 1137 35 -10 -6 7 -6 6 -6 7 -4 7 -2 6 5 -6 -64 0 -4 7 -3 6 4 -6 -64 0 0 2 -5 -6 -64 0 0 2 -4 -6 -64 -64 1138 57 -10 -6 7 -7 8 -3 3 -7 -10 -64 0 -2 3 -6 -10 -64 0 -4 -3 -4 -5 -3 -6 -1 -6 1 -5 2 -4 -64 0 4 3 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 5 3 3 -4 3 -5 4 -6 -64 -64 1139 43 -10 -6 7 -8 7 -4 3 -5 -6 -64 0 -3 3 -4 -3 -5 -6 -64 0 4 0 4 3 5 3 4 0 2 -3 -1 -5 -4 -6 -5 -6 -64 0 -6 3 -3 3 -64 -64 1140 77 -10 -6 7 -5 6 0 7 -1 6 -1 5 1 4 4 4 -64 0 2 4 -1 3 -2 2 -2 0 0 -1 3 -1 -64 0 2 4 0 3 -1 2 -1 0 0 -1 -64 0 1 -1 -2 -2 -3 -3 -3 -5 -1 -6 1 -7 2 -8 2 -9 1 -10 -1 -10 -64 0 1 -1 -1 -2 -2 -3 -2 -5 -1 -6 -64 -64 1141 61 -10 -6 7 -7 6 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 4 0 3 2 1 3 -1 3 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 3 1 1 3 -64 -64 1142 45 -10 -6 7 -9 8 -2 2 -5 -6 -64 0 -2 2 -4 -6 -64 0 2 2 1 -6 -64 0 2 2 2 -6 -64 0 -7 1 -5 3 6 3 -64 0 -7 1 -5 2 6 2 -64 -64 1143 63 -10 -6 7 -8 6 1 3 -1 3 -3 2 -4 1 -5 -1 -8 -10 -64 0 -1 3 -3 1 -4 -1 -7 -10 -64 0 1 3 3 2 4 0 4 -2 3 -4 2 -5 0 -6 -2 -6 -4 -5 -5 -3 -64 0 1 3 3 1 3 -2 2 -4 0 -6 -64 -64 1144 61 -10 -6 7 -7 9 7 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 4 0 3 2 7 2 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 3 1 1 3 -64 -64 1145 33 -10 -6 7 -7 8 1 2 -1 -6 -64 0 1 2 0 -6 -64 0 -5 1 -3 3 6 3 -64 0 -5 1 -3 2 6 2 -64 -64 1146 53 -10 -6 7 -8 6 -7 0 -6 2 -5 3 -3 3 -2 2 -2 0 -3 -3 -3 -5 -2 -6 -64 0 -4 3 -3 2 -3 0 -4 -3 -4 -5 -2 -6 -1 -6 1 -5 3 -3 4 0 4 3 3 3 4 2 -64 -64 1147 75 -10 -6 7 -7 8 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 3 -5 5 -3 6 0 6 2 5 3 3 3 2 2 1 0 0 -3 -3 -10 -64 0 -5 -3 -4 -4 -2 -5 0 -5 3 -4 5 -2 6 0 -64 0 6 1 5 2 3 2 1 0 -64 0 0 -3 -1 -6 -2 -10 -64 -64 1148 39 -10 -6 7 -7 6 -5 3 -4 3 -2 2 1 -9 2 -10 -64 0 -4 3 -3 2 0 -9 2 -10 3 -10 -64 0 4 3 2 0 -4 -7 -6 -10 -64 -64 1149 61 -10 -6 7 -9 9 2 7 -1 -10 -64 0 3 7 -2 -10 -64 0 -8 0 -7 2 -6 3 -4 3 -3 2 -3 -4 -2 -5 1 -5 3 -4 5 -2 -64 0 -5 3 -4 2 -4 -2 -3 -5 -2 -6 1 -6 3 -5 5 -2 6 0 7 3 -64 -64 1150 77 -10 -6 7 -8 8 -4 2 -2 2 -2 3 -4 2 -5 1 -6 -1 -6 -3 -5 -5 -4 -6 -2 -6 -1 -5 0 -3 1 0 -64 0 -6 -3 -4 -5 -2 -5 0 -3 -64 0 0 0 0 -5 1 -6 3 -6 5 -4 6 -2 6 0 5 2 4 3 4 2 5 2 -64 0 0 -3 1 -5 3 -5 5 -4 -64 -64 1151 69 -10 -6 7 -7 8 4 3 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 5 3 3 -4 3 -5 4 -6 -64 0 3 -1 3 1 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 -64 1152 69 -10 -6 7 -8 6 -3 7 -5 0 -64 0 -2 7 -4 0 -4 -4 -2 -6 -64 0 -4 0 -3 2 -1 3 1 3 3 2 4 0 4 -2 3 -4 2 -5 0 -6 -2 -6 -4 -5 -5 -3 -5 0 -64 0 1 3 3 1 3 -2 2 -4 0 -6 -64 0 -5 7 -2 7 -64 -64 1153 49 -10 -6 7 -7 6 3 2 3 1 4 1 3 2 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 -64 1154 75 -10 -6 7 -7 8 5 7 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 6 7 3 -4 3 -5 4 -6 -64 0 3 -1 3 1 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 3 7 6 7 -64 -64 1155 51 -10 -6 7 -7 5 -4 -3 0 -2 2 -1 3 0 3 2 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 -64 1156 51 -10 -6 7 -5 6 5 7 6 6 6 7 4 7 2 6 1 4 -2 -7 -3 -9 -4 -10 -64 0 4 7 3 6 2 4 -1 -7 -2 -9 -4 -10 -6 -10 -6 -9 -5 -10 -64 0 -2 3 4 3 -64 -64 1157 73 -10 -6 7 -7 7 4 3 2 -4 1 -7 0 -9 -64 0 5 3 3 -4 2 -7 0 -9 -2 -10 -5 -10 -6 -9 -5 -9 -4 -10 -64 0 3 -1 3 1 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 -64 1158 63 -10 -6 7 -7 8 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 -3 1 -2 2 0 3 2 3 4 2 4 0 3 -3 3 -5 4 -6 -64 0 2 3 3 2 3 0 2 -3 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 -4 7 -1 7 -64 -64 1159 57 -10 -6 7 -5 5 1 7 1 6 2 6 2 7 1 7 -64 0 -4 0 -3 2 -2 3 0 3 1 2 1 0 0 -3 0 -5 1 -6 -64 0 -1 3 0 2 0 0 -1 -3 -1 -5 0 -6 2 -6 3 -5 4 -3 -64 -64 1160 57 -10 -6 7 -5 5 2 7 2 6 3 6 3 7 2 7 -64 0 -3 0 -2 2 -1 3 1 3 2 2 2 0 0 -7 -1 -9 -3 -10 -5 -10 -5 -9 -4 -10 -64 0 0 3 1 2 1 0 -1 -7 -2 -9 -3 -10 -64 -64 1161 69 -10 -6 7 -7 6 -2 7 -6 -6 -64 0 -1 7 -5 -6 -64 0 4 2 3 1 4 1 4 2 3 3 2 3 0 1 -2 0 -3 0 -64 0 -3 0 -2 -1 -1 -5 0 -6 2 -6 3 -5 4 -3 -64 0 -3 0 -1 -1 0 -5 1 -6 -64 0 -4 7 -1 7 -64 -64 1162 37 -10 -6 7 -4 4 1 7 -2 -4 -2 -5 -1 -6 1 -6 2 -5 3 -3 -64 0 2 7 -1 -4 -1 -5 0 -6 -64 0 -1 7 2 7 -64 -64 1163 97 -10 -6 7 -12 12 -11 0 -10 2 -9 3 -7 3 -6 2 -6 1 -8 -6 -64 0 -8 3 -7 2 -7 1 -9 -6 -64 0 -6 1 -5 2 -3 3 -1 3 1 2 1 1 -1 -6 -64 0 -1 3 0 2 0 1 -2 -6 -64 0 1 1 2 2 4 3 6 3 8 2 8 0 7 -3 7 -5 8 -6 -64 0 6 3 7 2 7 0 6 -3 6 -5 7 -6 9 -6 10 -5 11 -3 -64 -64 1164 71 -10 -6 7 -8 9 -7 0 -6 2 -5 3 -3 3 -2 2 -2 1 -4 -6 -64 0 -4 3 -3 2 -3 1 -5 -6 -64 0 -2 1 -1 2 1 3 3 3 5 2 5 0 4 -3 4 -5 5 -6 -64 0 3 3 4 2 4 0 3 -3 3 -5 4 -6 6 -6 7 -5 8 -3 -64 -64 1165 61 -10 -6 7 -7 6 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 4 0 3 2 1 3 -1 3 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 3 1 1 3 -64 -64 1166 75 -10 -6 7 -8 7 -7 0 -6 2 -5 3 -3 3 -2 2 -2 1 -5 -10 -64 0 -4 3 -3 2 -3 1 -6 -10 -64 0 -2 1 0 3 2 3 4 2 5 0 5 -2 4 -4 3 -5 1 -6 -1 -6 -3 -4 -3 -2 -64 0 2 3 4 1 4 -2 3 -4 1 -6 -64 0 -8 -10 -3 -10 -64 -64 1167 61 -10 -6 7 -7 7 4 3 0 -10 -64 0 5 3 1 -10 -64 0 3 -1 3 1 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -4 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 -2 -10 3 -10 -64 -64 1168 49 -10 -6 7 -6 6 -5 0 -4 2 -3 3 -1 3 0 2 0 1 -2 -6 -64 0 -2 3 -1 2 -1 1 -3 -6 -64 0 0 1 1 2 3 3 4 3 5 2 5 1 4 1 5 2 -64 -64 1169 53 -10 -6 7 -6 7 4 2 4 1 5 1 4 2 2 3 -1 3 -3 2 -3 0 -1 -1 2 -2 4 -3 -64 0 -3 1 -1 0 2 -1 4 -2 4 -5 2 -6 -1 -6 -3 -5 -4 -4 -3 -4 -3 -5 -64 -64 1170 37 -10 -6 7 -4 5 1 7 -2 -4 -2 -5 -1 -6 1 -6 2 -5 3 -3 -64 0 2 7 -1 -4 -1 -5 0 -6 -64 0 -2 3 3 3 -64 -64 1171 71 -10 -6 7 -9 8 -8 0 -7 2 -6 3 -4 3 -3 2 -3 0 -4 -3 -4 -5 -3 -6 -64 0 -5 3 -4 2 -4 0 -5 -3 -5 -5 -3 -6 -1 -6 1 -5 2 -4 -64 0 4 3 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 5 3 3 -4 3 -5 4 -6 -64 -64 1172 53 -10 -6 7 -8 6 -7 0 -6 2 -5 3 -3 3 -2 2 -2 0 -3 -3 -3 -5 -2 -6 -64 0 -4 3 -3 2 -3 0 -4 -3 -4 -5 -2 -6 -1 -6 1 -5 3 -3 4 0 4 3 3 3 4 2 -64 -64 1173 79 -10 -6 7 -10 10 -9 0 -8 2 -7 3 -5 3 -4 2 -4 0 -5 -3 -5 -5 -4 -6 -64 0 -6 3 -5 2 -5 0 -6 -3 -6 -5 -4 -6 -3 -6 -1 -5 0 -4 -64 0 2 3 0 -4 0 -5 2 -6 -64 0 3 3 1 -4 1 -5 2 -6 3 -6 5 -5 7 -3 8 0 8 3 7 3 8 2 -64 -64 1174 81 -10 -6 7 -8 8 -5 0 -4 2 -2 3 0 3 1 2 1 0 -64 0 -1 3 0 2 0 0 -1 -3 -2 -5 -4 -6 -5 -6 -6 -5 -6 -4 -5 -4 -6 -5 -64 0 6 2 5 1 6 1 6 2 5 3 4 3 2 2 1 0 0 -3 0 -5 1 -6 -64 0 -1 -3 -1 -5 0 -6 2 -6 4 -5 5 -3 -64 -64 1175 75 -10 -6 7 -9 7 -8 0 -7 2 -6 3 -4 3 -3 2 -3 0 -4 -3 -4 -5 -3 -6 -64 0 -5 3 -4 2 -4 0 -5 -3 -5 -5 -3 -6 -1 -6 1 -5 2 -4 -64 0 4 3 2 -4 1 -7 0 -9 -64 0 5 3 3 -4 2 -7 0 -9 -2 -10 -5 -10 -6 -9 -5 -9 -4 -10 -64 -64 1176 59 -10 -6 7 -7 7 5 3 5 2 4 1 -4 -4 -5 -5 -5 -6 -64 0 -4 1 -3 3 0 3 3 1 -64 0 -3 2 0 2 3 1 4 1 -64 0 -4 -4 -3 -4 0 -5 3 -5 -64 0 -3 -4 0 -6 3 -6 4 -4 -64 -64 1177 83 -10 -6 7 -10 9 0 7 1 6 1 5 2 5 2 6 0 7 -3 7 -5 6 -6 4 -6 -6 -64 0 -3 7 -4 6 -5 4 -5 -6 -64 0 6 7 7 6 7 5 8 5 8 6 6 7 4 7 2 5 2 -6 -64 0 4 7 3 5 3 -6 -64 0 -8 3 5 3 -64 0 -8 -6 -3 -6 -64 0 0 -6 5 -6 -64 -64 1178 63 -10 -6 7 -8 9 3 7 4 6 5 6 5 7 -1 7 -3 6 -4 4 -4 -6 -64 0 -1 7 -2 6 -3 4 -3 -6 -64 0 4 3 4 -6 -64 0 5 3 5 -6 -64 0 -6 3 5 3 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1179 59 -10 -6 7 -8 9 5 7 -1 7 -3 6 -4 4 -4 -6 -64 0 -1 7 -2 6 -3 4 -3 -6 -64 0 3 7 4 6 4 -6 -64 0 5 7 5 -6 -64 0 -6 3 4 3 -64 0 -6 -6 -1 -6 -64 0 2 -6 7 -6 -64 -64 1180 101 -10 -6 7 -12 13 -2 7 -1 6 -1 5 0 5 0 6 -2 7 -5 7 -7 6 -8 4 -8 -6 -64 0 -5 7 -6 6 -7 4 -7 -6 -64 0 7 7 8 6 9 6 9 7 3 7 1 6 0 4 0 -6 -64 0 3 7 2 6 1 4 1 -6 -64 0 8 3 8 -6 -64 0 9 3 9 -6 -64 0 -10 3 9 3 -64 0 -10 -6 -5 -6 -64 0 -2 -6 3 -6 -64 0 6 -6 11 -6 -64 -64 1181 97 -10 -6 7 -12 13 -2 7 -1 6 -1 5 0 5 0 6 -2 7 -5 7 -7 6 -8 4 -8 -6 -64 0 -5 7 -6 6 -7 4 -7 -6 -64 0 9 7 3 7 1 6 0 4 0 -6 -64 0 3 7 2 6 1 4 1 -6 -64 0 7 7 8 6 8 -6 -64 0 9 7 9 -6 -64 0 -10 3 8 3 -64 0 -10 -6 -5 -6 -64 0 -2 -6 3 -6 -64 0 6 -6 11 -6 -64 -64 1182 29 -10 -6 7 -4 5 0 3 0 -6 -64 0 1 3 1 -6 -64 0 -2 3 1 3 -64 0 -2 -6 3 -6 -64 -64 1184 47 -10 -6 7 -6 6 4 2 2 3 0 3 -2 2 -3 1 -4 -1 -4 -3 -3 -5 -1 -6 1 -6 3 -5 -64 0 0 3 -2 1 -3 -1 -3 -4 -1 -6 -64 0 -3 -1 1 -1 -64 -64 1185 75 -10 -6 7 -6 7 1 7 -1 6 -2 5 -3 3 -4 0 -4 -3 -3 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 5 1 5 4 4 6 3 7 1 7 -64 0 1 7 -1 5 -2 3 -3 -1 -3 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 4 2 4 5 3 7 -64 0 -3 1 4 1 -64 -64 1186 73 -10 -6 7 -7 8 2 7 -1 -10 -64 0 3 7 -2 -10 -64 0 -1 3 -4 2 -5 0 -5 -3 -4 -5 -1 -6 2 -6 5 -5 6 -3 6 0 5 2 2 3 -1 3 -64 0 -1 3 -3 2 -4 0 -4 -3 -3 -5 -1 -6 -64 0 2 -6 4 -5 5 -3 5 0 4 2 2 3 -64 -64 1187 49 -10 -6 7 -6 6 3 2 4 0 4 1 3 2 1 3 -1 3 -3 2 -4 0 -4 -2 -3 -4 0 -6 -64 0 -1 3 -3 1 -3 -2 -2 -4 0 -6 1 -7 1 -9 0 -10 -2 -10 -64 -64 1191 95 -10 -6 7 -9 9 4 7 5 6 6 6 4 7 1 7 -1 6 -2 5 -3 3 -6 -7 -7 -9 -8 -10 -64 0 1 7 -1 5 -2 3 -5 -7 -6 -9 -8 -10 -10 -10 -10 -9 -9 -10 -64 0 8 7 9 6 9 7 7 7 5 6 4 4 1 -7 0 -9 -1 -10 -64 0 7 7 6 6 5 4 2 -7 1 -9 -1 -10 -3 -10 -3 -9 -2 -10 -64 0 -6 3 7 3 -64 -64 1192 81 -10 -6 7 -9 8 4 7 5 6 6 6 6 7 1 7 -1 6 -2 5 -3 3 -6 -7 -7 -9 -8 -10 -64 0 1 7 -1 5 -2 3 -5 -7 -6 -9 -8 -10 -10 -10 -10 -9 -9 -10 -64 0 4 3 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 5 3 3 -4 3 -5 4 -6 -64 0 -6 3 5 3 -64 -64 1193 81 -10 -6 7 -9 8 4 7 5 6 -64 0 6 7 1 7 -1 6 -2 5 -3 3 -6 -7 -7 -9 -8 -10 -64 0 1 7 -1 5 -2 3 -5 -7 -6 -9 -8 -10 -10 -10 -10 -9 -9 -10 -64 0 5 7 2 -4 2 -5 3 -6 5 -6 6 -5 7 -3 -64 0 6 7 3 -4 3 -5 4 -6 -64 0 -6 3 4 3 -64 -64 1194 131 -10 -6 7 -12 12 1 7 2 6 2 5 -64 0 3 6 1 7 -2 7 -4 6 -5 5 -6 3 -9 -7 -10 -9 -11 -10 -64 0 -2 7 -4 5 -5 3 -8 -7 -9 -9 -11 -10 -13 -10 -13 -9 -12 -10 -64 0 8 7 9 6 10 6 10 7 5 7 3 6 -64 0 2 5 1 3 -2 -7 -3 -9 -4 -10 -64 0 5 7 3 5 2 3 -1 -7 -2 -9 -4 -10 -6 -10 -6 -9 -5 -10 -64 0 8 3 6 -4 6 -5 7 -6 9 -6 10 -5 11 -3 -64 0 9 3 7 -4 7 -5 8 -6 -64 0 -9 3 9 3 -64 -64 1195 131 -10 -6 7 -12 12 1 7 2 6 2 5 -64 0 3 6 1 7 -2 7 -4 6 -5 5 -6 3 -9 -7 -10 -9 -11 -10 -64 0 -2 7 -4 5 -5 3 -8 -7 -9 -9 -11 -10 -13 -10 -13 -9 -12 -10 -64 0 8 7 9 6 -64 0 10 7 5 7 3 6 -64 0 2 5 1 3 -2 -7 -3 -9 -4 -10 -64 0 5 7 3 5 2 3 -1 -7 -2 -9 -4 -10 -6 -10 -6 -9 -5 -10 -64 0 9 7 6 -4 6 -5 7 -6 9 -6 10 -5 11 -3 -64 0 10 7 7 -4 7 -5 8 -6 -64 0 -9 3 8 3 -64 -64 1196 45 -10 -6 7 -5 5 -4 0 -3 2 -2 3 0 3 1 2 1 0 0 -3 0 -5 1 -6 -64 0 -1 3 0 2 0 0 -1 -3 -1 -5 0 -6 2 -6 3 -5 4 -3 -64 -64 1197 9 -10 -6 7 0 0 -64 0 -64 -64 1198 9 -10 -6 7 -3 3 -64 0 -64 -64 1199 9 -10 -6 7 -6 6 -64 0 -64 -64 1200 61 -10 -6 7 -6 7 -1 7 -3 6 -4 3 -4 -2 -3 -5 -1 -6 2 -6 4 -5 5 -2 5 3 4 6 2 7 -1 7 -64 0 -1 7 -2 6 -3 3 -3 -2 -2 -5 -1 -6 -64 0 2 -6 3 -5 4 -2 4 3 3 6 2 7 -64 -64 1201 25 -10 -6 7 -6 7 -2 4 1 7 1 -6 -64 0 0 6 0 -6 -64 0 -3 -6 4 -6 -64 -64 1202 75 -10 -6 7 -6 7 -3 5 -3 4 -4 4 -4 5 -3 6 -1 7 2 7 4 6 5 4 4 2 2 1 -1 0 -3 -1 -4 -3 -4 -6 -64 0 2 7 3 6 4 4 3 2 2 1 -64 0 -4 -5 -3 -4 -2 -4 1 -5 4 -5 5 -4 -64 0 -2 -4 1 -6 4 -6 5 -4 5 -3 -64 -64 1203 83 -10 -6 7 -6 7 -3 5 -3 4 -4 4 -4 5 -3 6 -1 7 2 7 4 6 5 4 4 2 2 1 -64 0 2 7 3 6 4 4 3 2 2 1 -64 0 0 1 2 1 4 0 5 -2 5 -3 4 -5 2 -6 -1 -6 -3 -5 -4 -4 -4 -3 -3 -3 -3 -4 -64 0 2 1 3 0 4 -2 4 -3 3 -5 2 -6 -64 -64 1204 31 -10 -6 7 -6 7 1 5 1 -6 -64 0 2 7 2 -6 -64 0 2 7 -5 -2 6 -2 -64 0 -1 -6 4 -6 -64 -64 1205 71 -10 -6 7 -6 7 -3 7 -4 1 -64 0 -3 7 4 7 -64 0 -3 6 1 6 4 7 -64 0 -4 1 -3 2 -1 3 2 3 4 2 5 0 5 -3 4 -5 2 -6 -1 -6 -3 -5 -4 -4 -4 -3 -3 -3 -3 -4 -64 0 2 3 3 2 4 0 4 -3 3 -5 2 -6 -64 -64 1206 77 -10 -6 7 -6 7 4 5 4 4 5 4 5 5 4 6 2 7 0 7 -2 6 -3 5 -4 2 -4 -3 -3 -5 -1 -6 2 -6 4 -5 5 -3 5 -1 4 1 2 2 -1 2 -4 0 -64 0 0 7 -2 5 -3 2 -3 -3 -2 -5 -1 -6 -64 0 2 -6 3 -5 4 -3 4 -1 3 1 2 2 -64 -64 1207 49 -10 -6 7 -6 7 -4 7 -4 3 -64 0 4 5 0 -2 -2 -6 -64 0 5 7 2 1 -1 -6 -64 0 -4 5 -2 7 0 7 3 5 -64 0 -4 5 -2 6 0 6 3 5 4 5 -64 -64 1208 107 -10 -6 7 -6 7 -1 7 -3 6 -4 4 -3 2 -1 1 2 1 4 2 5 4 4 6 2 7 -1 7 -64 0 -1 7 -2 6 -3 4 -2 2 -1 1 -64 0 2 1 3 2 4 4 3 6 2 7 -64 0 -1 1 -3 0 -4 -2 -4 -3 -3 -5 -1 -6 2 -6 4 -5 5 -3 5 -2 4 0 2 1 -64 0 -1 1 -2 0 -3 -2 -3 -3 -2 -5 -1 -6 -64 0 2 -6 3 -5 4 -3 4 -2 3 0 2 1 -64 -64 1209 77 -10 -6 7 -6 7 -3 -4 -3 -3 -4 -3 -4 -4 -3 -5 -1 -6 1 -6 3 -5 4 -4 5 -1 5 4 4 6 2 7 -1 7 -3 6 -4 4 -4 2 -3 0 -1 -1 2 -1 5 1 -64 0 1 -6 3 -4 4 -1 4 4 3 6 2 7 -64 0 -1 7 -2 6 -3 4 -3 2 -2 0 -1 -1 -64 -64 1210 17 -10 -6 7 -4 4 0 -4 -1 -5 0 -6 1 -5 0 -4 -64 -64 1211 21 -10 -6 7 -4 4 1 -5 0 -6 -1 -5 0 -4 1 -5 1 -7 -1 -9 -64 -64 1212 29 -10 -6 7 -4 4 0 3 -1 2 0 1 1 2 0 3 -64 0 0 -4 -1 -5 0 -6 1 -5 0 -4 -64 -64 1213 33 -10 -6 7 -4 4 0 3 -1 2 0 1 1 2 0 3 -64 0 1 -5 0 -6 -1 -5 0 -4 1 -5 1 -7 -1 -9 -64 -64 1214 35 -10 -6 7 -4 4 0 7 -1 6 0 -1 1 6 0 7 -64 0 0 6 0 3 -64 0 0 -4 -1 -5 0 -6 1 -5 0 -4 -64 -64 1215 63 -10 -6 7 -6 7 -4 4 -3 4 -3 3 -4 3 -4 4 -3 6 -1 7 2 7 4 6 5 4 5 3 4 1 1 0 0 -1 0 -2 1 -2 -64 0 2 7 4 5 4 2 3 1 1 0 -64 0 0 -5 0 -6 1 -6 1 -5 0 -5 -64 -64 1216 17 -10 -6 7 -3 4 0 7 0 2 -64 0 1 7 0 2 -64 -64 1217 29 -10 -6 7 -6 6 -3 7 -3 2 -64 0 -2 7 -3 2 -64 0 3 7 3 2 -64 0 4 7 3 2 -64 -64 1218 25 -10 -6 7 -5 5 -1 7 -2 6 -2 4 -1 3 1 3 2 4 2 6 1 7 -1 7 -64 -64 1219 23 -10 -6 7 -5 5 0 8 0 2 -64 0 -3 7 3 3 -64 0 3 7 -3 3 -64 -64 1220 11 -10 -6 7 -7 8 6 10 -5 -10 -64 -64 1221 37 -10 -6 7 -5 5 3 10 1 8 -1 5 -2 2 -2 -2 -1 -5 1 -8 3 -10 -64 0 1 8 0 6 -1 2 -1 -2 0 -6 1 -8 -64 -64 1222 37 -10 -6 7 -5 5 -3 10 -1 8 1 5 2 2 2 -2 1 -5 -1 -8 -3 -10 -64 0 -1 8 0 6 1 2 1 -2 0 -6 -1 -8 -64 -64 1223 29 -10 -6 7 -5 5 -2 10 -2 -10 -64 0 -1 10 -1 -10 -64 0 -2 10 3 10 -64 0 -2 -10 3 -10 -64 -64 1224 29 -10 -6 7 -5 5 1 10 1 -10 -64 0 2 10 2 -10 -64 0 -3 10 2 10 -64 0 -3 -10 2 -10 -64 -64 1225 57 -10 -6 7 -6 5 1 10 0 9 -1 7 -1 5 0 3 0 2 -2 0 0 -2 0 -3 -1 -5 -1 -7 0 -9 1 -10 -64 0 0 9 -1 5 -64 0 -1 7 0 3 -64 0 0 -3 -1 -7 -64 0 -1 -5 0 -9 -64 -64 1226 57 -10 -6 7 -5 6 -1 10 0 9 1 7 1 5 0 3 0 2 2 0 0 -2 0 -3 1 -5 1 -7 0 -9 -1 -10 -64 0 0 9 1 5 -64 0 1 7 0 3 -64 0 0 -3 1 -7 -64 0 1 -5 0 -9 -64 -64 1227 13 -10 -6 7 -5 5 2 10 -2 0 2 -10 -64 -64 1228 13 -10 -6 7 -5 5 -2 10 2 0 -2 -10 -64 -64 1229 11 -10 -6 7 -3 3 0 10 0 -10 -64 -64 1230 17 -10 -6 7 -5 5 -2 10 -2 -10 -64 0 2 10 2 -10 -64 -64 1231 11 -10 -6 7 -9 9 -6 0 6 0 -64 -64 1232 17 -10 -6 7 -9 9 0 6 0 -6 -64 0 -6 0 6 0 -64 -64 1233 23 -10 -6 7 -8 8 0 5 0 -6 -64 0 -5 0 5 0 -64 0 -5 -6 5 -6 -64 -64 1234 23 -10 -6 7 -8 8 0 5 0 -6 -64 0 -5 5 5 5 -64 0 -5 0 5 0 -64 -64 1235 17 -10 -6 7 -8 8 -5 5 5 -5 -64 0 5 5 -5 -5 -64 -64 1236 17 -10 -6 7 -4 4 0 1 -1 0 0 -1 1 0 0 1 -64 -64 1237 35 -10 -6 7 -9 9 0 6 -1 5 0 4 1 5 0 6 -64 0 -6 0 6 0 -64 0 0 -4 -1 -5 0 -6 1 -5 0 -4 -64 -64 1238 17 -10 -6 7 -9 9 -6 2 6 2 -64 0 -6 -2 6 -2 -64 -64 1239 23 -10 -6 7 -9 9 5 6 -5 -6 -64 0 -6 2 6 2 -64 0 -6 -2 6 -2 -64 -64 1240 23 -10 -6 7 -9 9 -6 4 6 4 -64 0 -6 0 6 0 -64 0 -6 -4 6 -4 -64 -64 1241 13 -10 -6 7 -8 8 5 6 -5 0 5 -6 -64 -64 1242 13 -10 -6 7 -8 8 -5 6 5 0 -5 -6 -64 -64 1243 25 -10 -6 7 -8 8 5 7 -5 3 5 -1 -64 0 -5 -2 5 -2 -64 0 -5 -6 5 -6 -64 -64 1244 25 -10 -6 7 -8 8 -5 7 5 3 -5 -1 -64 0 -5 -2 5 -2 -64 0 -5 -6 5 -6 -64 -64 1245 47 -10 -6 7 -10 9 7 -3 5 -3 3 -2 2 -1 0 2 -1 3 -3 4 -4 4 -6 3 -7 1 -7 0 -6 -2 -4 -3 -3 -3 -1 -2 0 -1 2 2 3 3 5 4 7 4 -64 -64 1246 37 -10 -6 7 -8 8 -6 -2 -6 0 -5 2 -3 2 3 -1 5 -1 6 0 -64 0 -6 0 -5 1 -3 1 3 -2 5 -2 6 0 6 2 -64 -64 1247 21 -10 -6 7 -8 8 -5 -1 0 2 5 -1 -64 0 -5 -1 0 1 5 -1 -64 -64 1248 19 -10 -6 7 -4 4 1 7 -2 3 -64 0 1 7 2 6 -2 3 -64 -64 1249 19 -10 -6 7 -4 4 -1 7 2 3 -64 0 -1 7 -2 6 2 3 -64 -64 1250 33 -10 -6 7 -6 6 -4 7 -3 5 -1 4 1 4 3 5 4 7 -64 0 -4 7 -3 4 -1 3 1 3 3 4 4 7 -64 -64 1251 21 -10 -6 7 -4 4 1 6 0 5 -1 6 0 7 1 6 1 4 -1 2 -64 -64 1252 21 -10 -6 7 -4 4 1 7 -1 5 -1 3 0 2 1 3 0 4 -1 3 -64 -64 1253 21 -10 -6 7 -4 4 -1 6 0 5 1 6 0 7 -1 6 -1 4 1 2 -64 -64 1254 21 -10 -6 7 -4 4 -1 7 1 5 1 3 0 2 -1 3 0 4 1 3 -64 -64 1256 27 -10 -6 7 -8 8 5 5 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 -3 -4 -1 -5 5 -5 -64 -64 1257 27 -10 -6 7 -8 8 -5 5 -5 -1 -4 -3 -3 -4 -1 -5 1 -5 3 -4 4 -3 5 -1 5 5 -64 -64 1258 27 -10 -6 7 -8 8 -5 5 1 5 3 4 4 3 5 1 5 -1 4 -3 3 -4 1 -5 -5 -5 -64 -64 1259 27 -10 -6 7 -8 8 -5 -5 -5 1 -4 3 -3 4 -1 5 1 5 3 4 4 3 5 1 5 -5 -64 -64 1260 33 -10 -6 7 -8 8 5 5 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 -3 -4 -1 -5 5 -5 -64 0 -5 0 3 0 -64 -64 1261 31 -10 -6 7 -9 9 2 3 3 2 6 0 3 -2 2 -3 -64 0 3 2 5 0 3 -2 -64 0 -6 0 5 0 -64 -64 1262 31 -10 -6 7 -5 5 0 5 0 -6 -64 0 -3 2 -2 3 0 6 2 3 3 2 -64 0 -2 3 0 5 2 3 -64 -64 1263 31 -10 -6 7 -9 9 -2 3 -3 2 -6 0 -3 -2 -2 -3 -64 0 -3 2 -5 0 -3 -2 -64 0 -5 0 6 0 -64 -64 1264 31 -10 -6 7 -5 5 0 6 0 -5 -64 0 -3 -2 -2 -3 0 -6 2 -3 3 -2 -64 0 -2 -3 0 -5 2 -3 -64 -64 1265 79 -10 -6 7 -7 7 4 -1 3 2 1 3 -1 3 -3 2 -4 1 -5 -1 -5 -3 -4 -5 -2 -6 0 -6 2 -5 3 -4 4 -2 5 1 5 4 4 6 2 7 -1 7 -2 6 -1 6 0 7 -64 0 -1 3 -3 1 -4 -1 -4 -4 -2 -6 -64 0 0 -6 2 -4 3 -2 4 1 4 4 3 6 2 7 -64 -64 1266 35 -10 -6 7 -8 8 -6 7 0 -6 -64 0 -5 7 0 -4 -64 0 6 7 0 -6 -64 0 -6 7 6 7 -64 0 -4 6 5 6 -64 -64 1267 25 -10 -6 7 -11 9 -9 3 -6 3 0 -5 -64 0 -7 3 0 -6 -64 0 9 12 0 -6 -64 -64 1268 57 -10 -6 7 -9 9 6 9 6 8 7 8 7 9 6 10 4 10 2 8 1 6 0 3 -1 -3 -2 -7 -3 -9 -64 0 3 9 2 7 1 3 0 -3 -1 -6 -2 -8 -4 -10 -6 -10 -7 -9 -7 -8 -6 -8 -6 -9 -64 -64 1269 85 -10 -6 7 -9 9 6 9 6 8 7 8 7 9 6 10 4 10 2 8 1 6 0 3 -1 -3 -2 -7 -3 -9 -64 0 3 9 2 7 1 3 0 -3 -1 -6 -2 -8 -4 -10 -6 -10 -7 -9 -7 -8 -6 -8 -6 -9 -64 0 -1 4 -3 3 -4 1 -4 -1 -3 -3 -1 -4 1 -4 3 -3 4 -1 4 1 3 3 1 4 -1 4 -64 -64 1270 57 -10 -6 7 -10 10 8 0 7 -2 5 -3 4 -3 2 -2 1 -1 -1 2 -2 3 -4 4 -5 4 -7 3 -8 1 -8 0 -7 -2 -5 -3 -4 -3 -2 -2 -1 -1 1 2 2 3 4 4 5 4 7 3 8 1 8 0 -64 -64 1271 57 -10 -6 7 -8 8 6 7 -6 -6 -64 0 -3 7 -2 6 -2 4 -3 3 -5 3 -6 4 -6 6 -5 7 -3 7 1 6 4 6 6 7 -64 0 3 -2 2 -3 2 -5 3 -6 5 -6 6 -5 6 -3 5 -2 3 -2 -64 -64 1272 87 -10 -6 7 -8 9 7 2 6 2 6 1 7 1 7 2 6 3 5 3 4 2 3 -2 2 -4 1 -5 -1 -6 -3 -6 -5 -5 -6 -4 -6 -2 -5 -1 -3 0 0 2 1 4 1 6 0 7 -2 7 -3 6 -3 4 -2 1 3 -5 5 -6 6 -6 7 -5 -64 0 -3 -6 -5 -4 -5 -2 -3 0 -64 0 -3 4 -2 2 4 -5 5 -6 -64 -64 1273 63 -10 -6 7 -8 9 3 2 1 3 -1 3 -2 1 -2 0 -1 -2 1 -2 3 -1 -64 0 3 3 3 -1 4 -2 6 -2 7 0 7 1 6 4 4 6 1 7 0 7 -3 6 -5 4 -6 1 -6 0 -5 -3 -3 -5 0 -6 1 -6 4 -5 -64 -64 1274 73 -10 -6 7 -7 8 -1 10 -1 -10 -64 0 2 10 2 -10 -64 0 5 6 4 6 4 5 5 5 5 6 3 7 -2 7 -4 6 -4 4 -3 2 4 -1 5 -2 -64 0 -4 4 -3 3 4 0 5 -2 5 -4 4 -5 2 -6 -1 -6 -3 -5 -4 -4 -4 -3 -3 -3 -3 -4 -4 -4 -64 -64 1275 29 -10 -6 7 -7 7 0 7 -4 -10 -64 0 4 7 0 -10 -64 0 -4 1 5 1 -64 0 -5 -4 4 -4 -64 -64 1276 85 -10 -6 7 -6 6 2 6 1 6 1 5 2 5 2 6 1 7 -1 7 -2 6 -2 4 -1 2 2 0 3 -1 -64 0 -2 4 -1 3 2 1 3 -1 3 -3 1 -5 -64 0 -1 2 -3 0 -3 -2 -2 -4 1 -6 2 -7 -64 0 -3 -2 -2 -3 1 -5 2 -7 2 -9 1 -10 -1 -10 -2 -9 -2 -8 -1 -8 -1 -9 -2 -9 -64 -64 1277 63 -10 -6 7 -6 6 0 7 -1 6 0 5 1 6 0 7 -64 0 0 5 0 1 -64 0 0 1 -1 -1 0 -4 1 -1 0 1 -64 0 0 -4 0 -10 -64 0 -2 3 -3 4 -4 3 -3 2 -2 3 2 3 3 4 4 3 3 2 2 3 -64 -64 1278 89 -10 -6 7 -6 6 0 5 1 6 0 7 -1 6 0 5 0 1 -1 0 1 -3 0 -4 -64 0 0 1 1 0 -1 -3 0 -4 0 -8 -1 -9 0 -10 1 -9 0 -8 -64 0 -2 3 -3 4 -4 3 -3 2 -2 3 2 3 3 4 4 3 3 2 2 3 -64 0 -2 -6 -3 -5 -4 -6 -3 -7 -2 -6 2 -6 3 -5 4 -6 3 -7 2 -6 -64 -64 1279 29 -10 -6 7 -6 7 4 7 4 -6 -64 0 -4 7 4 7 -64 0 -1 1 4 1 -64 0 -4 -6 4 -6 -64 -64 1281 53 -10 -6 7 -10 10 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -1 7 1 6 4 4 6 1 7 -1 7 -64 0 0 1 -1 0 0 -1 1 0 0 1 -64 -64 1282 71 -10 -6 7 -6 7 -1 7 -2 6 -2 5 -1 4 -64 0 2 7 3 6 3 5 2 4 -64 0 0 4 -2 3 -3 1 -3 0 -2 -2 0 -3 1 -3 3 -2 4 0 4 1 3 3 1 4 0 4 -64 0 0 -3 0 -7 -64 0 1 -3 1 -7 -64 0 -3 -5 4 -5 -64 -64 1283 51 -10 -6 7 -6 7 0 7 -2 6 -3 4 -3 3 -2 1 0 0 1 0 3 1 4 3 4 4 3 6 1 7 0 7 -64 0 0 0 0 -6 -64 0 1 0 1 -6 -64 0 -3 -3 4 -3 -64 -64 1284 53 -10 -6 7 -10 10 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -1 7 1 6 4 4 6 1 7 -1 7 -64 0 0 7 0 -7 -64 0 -7 0 7 0 -64 -64 1285 55 -10 -6 7 -8 7 0 0 -2 1 -3 1 -5 0 -6 -2 -6 -3 -5 -5 -3 -6 -2 -6 0 -5 1 -3 1 -2 0 0 -64 0 5 5 0 0 -64 0 0 5 5 5 5 0 -64 0 0 5 4 4 5 0 -64 -64 1286 55 -10 -6 7 -8 8 -6 6 -5 7 -3 7 -1 6 0 4 0 2 -1 0 -2 -1 -4 -2 -64 0 -3 7 -2 6 -1 4 -1 1 -2 -1 -64 0 4 7 3 -6 -64 0 5 7 2 -6 -64 0 -4 -2 6 -2 -64 -64 1287 59 -10 -6 7 -8 7 -4 7 -4 -3 -64 0 -3 7 -4 0 -64 0 -4 0 -3 2 -1 3 1 3 3 2 4 1 4 -2 2 -4 2 -6 3 -7 4 -7 5 -6 -64 0 1 3 3 1 3 -2 2 -4 -64 0 -6 7 -3 7 -64 -64 1288 59 -10 -6 7 -6 7 -3 4 0 7 0 1 -64 0 4 4 1 7 1 1 -64 0 0 1 -2 0 -3 -2 -3 -3 -2 -5 0 -6 1 -6 3 -5 4 -3 4 -2 3 0 1 1 -64 0 0 -2 0 -3 1 -3 1 -2 0 -2 -64 -64 1289 59 -10 -6 7 -8 8 0 7 0 -7 -64 0 -5 7 -5 2 -4 0 -2 -1 2 -1 4 0 5 2 5 7 -64 0 -6 5 -5 7 -4 5 -64 0 -1 5 0 7 1 5 -64 0 4 5 5 7 6 5 -64 0 -3 -4 3 -4 -64 -64 1290 59 -10 -6 7 -8 7 -4 7 -4 -6 -64 0 -3 7 -3 -6 -64 0 -6 7 1 7 4 6 5 4 5 3 4 1 1 0 -3 0 -64 0 1 7 3 6 4 4 4 3 3 1 1 0 -64 0 -6 -6 4 -6 4 -3 3 -6 -64 -64 1291 45 -10 -6 7 -6 7 5 7 2 7 -1 6 -3 4 -4 1 -4 -1 -3 -4 -1 -6 2 -7 5 -7 -64 0 5 7 2 6 0 4 -1 1 -1 -1 0 -4 2 -6 5 -7 -64 -64 1292 51 -10 -6 7 -8 8 0 0 -2 1 -3 1 -5 0 -6 -2 -6 -3 -5 -5 -3 -6 -2 -6 0 -5 1 -3 1 -2 0 0 -64 0 1 6 -1 1 -64 0 5 5 0 0 -64 0 6 1 1 -1 -64 -64 1293 29 -10 -6 7 -7 7 -2 5 2 -5 -64 0 2 5 -2 -5 -64 0 -5 2 5 -2 -64 0 5 2 -5 -2 -64 -64 1294 73 -10 -6 7 -8 9 -3 -3 -5 -3 -6 -4 -6 -6 -5 -7 -3 -7 -2 -6 -2 -4 -4 -2 -5 0 -5 3 -4 5 -3 6 -1 7 2 7 4 6 5 5 6 3 6 0 5 -2 3 -4 3 -6 4 -7 6 -7 7 -6 7 -4 6 -3 4 -3 -64 0 -4 5 -2 6 3 6 5 5 -64 -64 1295 73 -10 -6 7 -8 9 -3 3 -5 3 -6 4 -6 6 -5 7 -3 7 -2 6 -2 4 -4 2 -5 0 -5 -3 -4 -5 -3 -6 -1 -7 2 -7 4 -6 5 -5 6 -3 6 0 5 2 3 4 3 6 4 7 6 7 7 6 7 4 6 3 4 3 -64 0 -4 -5 -2 -6 3 -6 5 -5 -64 -64 1401 47 -10 -6 7 -12 12 -7 10 -7 -10 -64 0 -6 10 -6 -10 -64 0 6 10 6 -10 -64 0 7 10 7 -10 -64 0 -10 10 10 10 -64 0 -10 -10 -3 -10 -64 0 3 -10 10 -10 -64 -64 1402 45 -10 -6 7 -10 11 -7 10 0 1 -8 -10 -64 0 -8 10 -1 1 -64 0 -8 10 7 10 8 5 6 10 -64 0 -7 -9 6 -9 -64 0 -8 -10 7 -10 8 -5 6 -10 -64 -64 1403 45 -10 -6 7 -7 7 4 16 2 14 0 11 -2 7 -3 2 -3 -2 -2 -7 0 -11 2 -14 4 -16 -64 0 2 14 0 10 -1 7 -2 2 -2 -2 -1 -7 0 -10 2 -14 -64 -64 1404 45 -10 -6 7 -7 7 -4 16 -2 14 0 11 2 7 3 2 3 -2 2 -7 0 -11 -2 -14 -4 -16 -64 0 -2 14 0 10 1 7 2 2 2 -2 1 -7 0 -10 -2 -14 -64 -64 1405 29 -10 -6 7 -7 7 -3 16 -3 -16 -64 0 -2 16 -2 -16 -64 0 -3 16 4 16 -64 0 -3 -16 4 -16 -64 -64 1406 29 -10 -6 7 -7 7 2 16 2 -16 -64 0 3 16 3 -16 -64 0 -4 16 3 16 -64 0 -4 -16 3 -16 -64 -64 1407 57 -10 -6 7 -8 7 2 16 -1 13 -2 10 -2 8 -1 5 1 3 1 2 -3 0 1 -2 1 -3 -1 -5 -2 -8 -2 -10 -1 -13 2 -16 -64 0 0 14 -1 11 -1 7 0 4 -64 0 0 -4 -1 -7 -1 -11 0 -14 -64 -64 1408 57 -10 -6 7 -7 8 -2 16 1 13 2 10 2 8 1 5 -1 3 -1 2 3 0 -1 -2 -1 -3 1 -5 2 -8 2 -10 1 -13 -2 -16 -64 0 0 14 1 11 1 7 0 4 -64 0 0 -4 1 -7 1 -11 0 -14 -64 -64 1409 53 -10 -6 7 -7 7 3 18 0 15 -2 12 -3 9 -3 6 -2 3 1 -4 2 -7 2 -10 1 -13 0 -15 -64 0 0 15 -1 13 -2 10 -2 7 -1 4 2 -3 3 -6 3 -9 2 -12 0 -15 -3 -18 -64 -64 1410 53 -10 -6 7 -7 7 -3 18 0 15 2 12 3 9 3 6 2 3 -1 -4 -2 -7 -2 -10 -1 -13 0 -15 -64 0 0 15 1 13 2 10 2 7 1 4 -2 -3 -3 -6 -3 -9 -2 -12 0 -15 3 -18 -64 -64 1411 31 -10 -6 7 -17 6 -15 0 -11 0 0 -14 -64 0 -11 -1 0 -15 -64 0 -12 -1 0 -16 -64 0 6 24 0 -16 -64 -64 1412 69 -10 -6 7 -12 12 9 15 8 14 9 13 10 14 10 15 9 16 7 16 5 15 3 13 2 11 1 8 0 4 -2 -8 -3 -12 -4 -14 -64 0 4 14 3 12 2 8 0 -4 -1 -8 -2 -11 -3 -13 -5 -15 -7 -16 -9 -16 -10 -15 -10 -14 -9 -13 -8 -14 -9 -15 -64 -64 2001 41 -16 -9 12 -10 10 0 12 -7 -9 -64 0 0 12 7 -9 -64 0 0 9 6 -9 -64 0 -5 -3 4 -3 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2002 95 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -64 0 3 12 5 11 6 10 7 8 7 6 6 4 5 3 3 2 -64 0 -5 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -9 -9 -64 0 3 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 -64 -64 2003 69 -16 -9 12 -11 10 6 9 7 6 7 12 6 9 4 11 1 12 -1 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 -64 0 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 -64 -64 2004 65 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 1 12 4 11 6 9 7 7 8 4 8 -1 7 -4 6 -6 4 -8 1 -9 -9 -9 -64 0 1 12 3 11 5 9 6 7 7 4 7 -1 6 -4 5 -6 3 -8 1 -9 -64 -64 2005 49 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 1 6 1 -2 -64 0 -9 12 7 12 7 6 6 12 -64 0 -5 2 1 2 -64 0 -9 -9 7 -9 7 -3 6 -9 -64 -64 2006 45 -16 -9 12 -11 9 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 1 6 1 -2 -64 0 -9 12 7 12 7 6 6 12 -64 0 -5 2 1 2 -64 0 -9 -9 -2 -9 -64 -64 2007 85 -16 -9 12 -11 12 6 9 7 6 7 12 6 9 4 11 1 12 -1 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 6 -1 6 -9 -64 0 7 -1 7 -9 -64 0 3 -1 10 -1 -64 -64 2008 59 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 -6 2 6 2 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2009 29 -16 -9 12 -5 6 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -3 12 4 12 -64 0 -3 -9 4 -9 -64 -64 2010 45 -16 -9 12 -7 8 3 12 3 -5 2 -8 0 -9 -2 -9 -4 -8 -5 -6 -5 -4 -4 -3 -3 -4 -4 -5 -64 0 2 12 2 -5 1 -8 0 -9 -64 0 -1 12 6 12 -64 -64 2011 59 -16 -9 12 -12 10 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 7 12 -6 -1 -64 0 -1 3 7 -9 -64 0 -2 3 6 -9 -64 0 -10 12 -3 12 -64 0 3 12 9 12 -64 0 -10 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2012 33 -16 -9 12 -9 9 -4 12 -4 -9 -64 0 -3 12 -3 -9 -64 0 -7 12 0 12 -64 0 -7 -9 8 -9 8 -3 7 -9 -64 -64 2013 65 -16 -9 12 -12 13 -7 12 -7 -9 -64 0 -6 12 0 -6 -64 0 -7 12 0 -9 -64 0 7 12 0 -9 -64 0 7 12 7 -9 -64 0 8 12 8 -9 -64 0 -10 12 -6 12 -64 0 7 12 11 12 -64 0 -10 -9 -4 -9 -64 0 4 -9 11 -9 -64 -64 2014 47 -16 -9 12 -11 12 -6 12 -6 -9 -64 0 -5 12 7 -7 -64 0 -5 10 7 -9 -64 0 7 12 7 -9 -64 0 -9 12 -5 12 -64 0 4 12 10 12 -64 0 -9 -9 -3 -9 -64 -64 2015 93 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -5 9 -6 7 -7 3 -7 0 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -4 7 0 7 3 6 7 5 9 3 11 1 12 -64 -64 2016 63 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 5 7 3 6 2 3 1 -5 1 -64 0 3 12 5 11 6 10 7 8 7 5 6 3 5 2 3 1 -64 0 -9 -9 -2 -9 -64 -64 2017 133 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -5 9 -6 7 -7 3 -7 0 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -4 7 0 7 3 6 7 5 9 3 11 1 12 -64 0 -4 -7 -4 -6 -3 -4 -1 -3 0 -3 2 -4 3 -6 4 -13 5 -14 7 -14 8 -12 8 -11 -64 0 3 -6 4 -10 5 -12 6 -13 7 -13 8 -12 -64 -64 2018 95 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -5 2 -64 0 3 12 5 11 6 10 7 8 7 6 6 4 5 3 3 2 -64 0 -9 -9 -2 -9 -64 0 0 2 2 1 3 0 6 -7 7 -8 8 -8 9 -7 -64 0 2 1 3 -1 5 -8 6 -9 8 -9 9 -7 9 -6 -64 -64 2019 73 -16 -9 12 -10 10 6 9 7 12 7 6 6 9 4 11 1 12 -2 12 -5 11 -7 9 -7 7 -6 5 -5 4 -3 3 3 1 5 0 7 -2 -64 0 -7 7 -5 5 -3 4 3 2 5 1 6 0 7 -2 7 -6 5 -8 2 -9 -1 -9 -4 -8 -6 -6 -7 -3 -7 -9 -6 -6 -64 -64 2020 37 -16 -9 12 -9 10 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -6 12 -7 6 -7 12 8 12 8 6 7 12 -64 0 -3 -9 4 -9 -64 -64 2021 51 -16 -9 12 -12 12 -7 12 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 12 -64 0 -6 12 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 -10 12 -3 12 -64 0 4 12 10 12 -64 -64 2022 35 -16 -9 12 -10 10 -7 12 0 -9 -64 0 -6 12 0 -6 -64 0 7 12 0 -9 -64 0 -9 12 -3 12 -64 0 3 12 9 12 -64 -64 2023 53 -16 -9 12 -12 12 -8 12 -4 -9 -64 0 -7 12 -4 -4 -64 0 0 12 -4 -9 -64 0 0 12 4 -9 -64 0 1 12 4 -4 -64 0 8 12 4 -9 -64 0 -11 12 -4 12 -64 0 5 12 11 12 -64 -64 2024 47 -16 -9 12 -10 10 -7 12 6 -9 -64 0 -6 12 7 -9 -64 0 7 12 -7 -9 -64 0 -9 12 -3 12 -64 0 3 12 9 12 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2025 45 -16 -9 12 -10 11 -7 12 0 1 0 -9 -64 0 -6 12 1 1 1 -9 -64 0 8 12 1 1 -64 0 -9 12 -3 12 -64 0 4 12 10 12 -64 0 -3 -9 4 -9 -64 -64 2026 37 -16 -9 12 -10 10 6 12 -7 -9 -64 0 7 12 -6 -9 -64 0 -6 12 -7 6 -7 12 7 12 -64 0 -7 -9 7 -9 7 -3 6 -9 -64 -64 2027 41 -16 -9 12 -10 10 0 12 -7 -9 -64 0 0 12 7 -9 -64 0 0 9 6 -9 -64 0 -5 -3 4 -3 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2028 95 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -64 0 3 12 5 11 6 10 7 8 7 6 6 4 5 3 3 2 -64 0 -5 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -9 -9 -64 0 3 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 -64 -64 2029 33 -16 -9 12 -9 9 -4 12 -4 -9 -64 0 -3 12 -3 -9 -64 0 -7 12 8 12 8 6 7 12 -64 0 -7 -9 0 -9 -64 -64 2030 35 -16 -9 12 -10 10 0 12 -8 -9 -64 0 0 12 8 -9 -64 0 0 9 7 -9 -64 0 -7 -8 7 -8 -64 0 -8 -9 8 -9 -64 -64 2031 49 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 1 6 1 -2 -64 0 -9 12 7 12 7 6 6 12 -64 0 -5 2 1 2 -64 0 -9 -9 7 -9 7 -3 6 -9 -64 -64 2032 37 -16 -9 12 -10 10 6 12 -7 -9 -64 0 7 12 -6 -9 -64 0 -6 12 -7 6 -7 12 7 12 -64 0 -7 -9 7 -9 7 -3 6 -9 -64 -64 2033 59 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 -6 2 6 2 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2034 117 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -5 9 -6 7 -7 3 -7 0 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -4 7 0 7 3 6 7 5 9 3 11 1 12 -64 0 -3 5 -3 -2 -64 0 3 5 3 -2 -64 0 -3 2 3 2 -64 0 -3 1 3 1 -64 -64 2035 29 -16 -9 12 -5 6 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -3 12 4 12 -64 0 -3 -9 4 -9 -64 -64 2036 59 -16 -9 12 -12 10 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 7 12 -6 -1 -64 0 -1 3 7 -9 -64 0 -2 3 6 -9 -64 0 -10 12 -3 12 -64 0 3 12 9 12 -64 0 -10 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2037 35 -16 -9 12 -10 10 0 12 -7 -9 -64 0 0 12 7 -9 -64 0 0 9 6 -9 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2038 65 -16 -9 12 -12 13 -7 12 -7 -9 -64 0 -6 12 0 -6 -64 0 -7 12 0 -9 -64 0 7 12 0 -9 -64 0 7 12 7 -9 -64 0 8 12 8 -9 -64 0 -10 12 -6 12 -64 0 7 12 11 12 -64 0 -10 -9 -4 -9 -64 0 4 -9 11 -9 -64 -64 2039 47 -16 -9 12 -11 12 -6 12 -6 -9 -64 0 -5 12 7 -7 -64 0 -5 10 7 -9 -64 0 7 12 7 -9 -64 0 -9 12 -5 12 -64 0 4 12 10 12 -64 0 -9 -9 -3 -9 -64 -64 2040 77 -16 -9 12 -11 11 -7 13 -8 8 -64 0 8 13 7 8 -64 0 -3 4 -4 -1 -64 0 4 4 3 -1 -64 0 -7 -5 -8 -10 -64 0 8 -5 7 -10 -64 0 -7 11 7 11 -64 0 -7 10 7 10 -64 0 -3 2 3 2 -64 0 -3 1 3 1 -64 0 -7 -7 7 -7 -64 0 -7 -8 7 -8 -64 -64 2041 93 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -5 9 -6 7 -7 3 -7 0 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -4 7 0 7 3 6 7 5 9 3 11 1 12 -64 -64 2042 47 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 10 12 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2043 63 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 5 7 3 6 2 3 1 -5 1 -64 0 3 12 5 11 6 10 7 8 7 5 6 3 5 2 3 1 -64 0 -9 -9 -2 -9 -64 -64 2044 45 -16 -9 12 -10 11 -7 12 0 2 -8 -9 -64 0 -8 12 -1 2 -64 0 -8 12 7 12 8 6 6 12 -64 0 -7 -8 6 -8 -64 0 -8 -9 7 -9 8 -3 6 -9 -64 -64 2045 37 -16 -9 12 -9 10 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -6 12 -7 6 -7 12 8 12 8 6 7 12 -64 0 -3 -9 4 -9 -64 -64 2046 71 -16 -9 12 -9 10 -7 7 -7 9 -6 11 -5 12 -3 12 -2 11 -1 9 0 5 0 -9 -64 0 -7 9 -5 11 -3 11 -1 9 -64 0 8 7 8 9 7 11 6 12 4 12 3 11 2 9 1 5 1 -9 -64 0 8 9 6 11 4 11 2 9 -64 0 -3 -9 4 -9 -64 -64 2047 101 -16 -9 12 -10 11 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -2 7 -5 6 -6 5 -7 3 -7 0 -6 -2 -5 -3 -2 -4 3 -4 6 -3 7 -2 8 0 8 3 7 5 6 6 3 7 -2 7 -64 0 -2 7 -4 6 -5 5 -6 3 -6 0 -5 -2 -4 -3 -2 -4 -64 0 3 -4 5 -3 6 -2 7 0 7 3 6 5 5 6 3 7 -64 0 -3 12 4 12 -64 0 -3 -9 4 -9 -64 -64 2048 47 -16 -9 12 -10 10 -7 12 6 -9 -64 0 -6 12 7 -9 -64 0 7 12 -7 -9 -64 0 -9 12 -3 12 -64 0 3 12 9 12 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2049 87 -16 -9 12 -11 12 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -9 5 -8 6 -6 5 -5 1 -4 -1 -3 -2 -1 -3 -64 0 -8 6 -7 5 -6 1 -5 -1 -4 -2 -1 -3 2 -3 5 -2 6 -1 7 1 8 5 9 6 -64 0 2 -3 4 -2 5 -1 6 1 7 5 9 6 10 5 -64 0 -3 12 4 12 -64 0 -3 -9 4 -9 -64 -64 2050 91 -16 -9 12 -11 11 -8 -6 -7 -9 -3 -9 -5 -5 -7 -1 -8 2 -8 6 -7 9 -5 11 -2 12 2 12 5 11 7 9 8 6 8 2 7 -1 5 -5 3 -9 7 -9 8 -6 -64 0 -5 -5 -6 -2 -7 2 -7 6 -6 9 -4 11 -2 12 -64 0 2 12 4 11 6 9 7 6 7 2 6 -2 5 -5 -64 0 -7 -8 -4 -8 -64 0 4 -8 7 -8 -64 -64 2051 41 -16 -9 12 -10 10 3 12 -10 -9 -64 0 3 12 4 -9 -64 0 2 10 3 -9 -64 0 -6 -3 3 -3 -64 0 -12 -9 -6 -9 -64 0 0 -9 6 -9 -64 -64 2052 87 -16 -9 12 -12 12 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 5 12 8 11 9 9 9 7 8 4 7 3 4 2 -64 0 5 12 7 11 8 9 8 7 7 4 6 3 4 2 -64 0 -5 2 4 2 6 1 7 -1 7 -3 6 -6 4 -8 0 -9 -12 -9 -64 0 4 2 5 1 6 -1 6 -3 5 -6 3 -8 0 -9 -64 -64 2053 73 -16 -9 12 -10 11 8 10 9 10 10 12 9 6 9 8 8 10 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -2 -9 1 -9 3 -8 5 -6 6 -4 -64 0 2 12 0 11 -2 9 -4 6 -5 3 -6 -1 -6 -4 -5 -7 -4 -8 -2 -9 -64 -64 2054 65 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 3 12 6 11 7 10 8 7 8 3 7 -1 5 -5 3 -7 1 -8 -3 -9 -12 -9 -64 0 3 12 5 11 6 10 7 7 7 3 6 -1 4 -5 2 -7 0 -8 -3 -9 -64 -64 2055 49 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 2 6 0 -2 -64 0 -6 12 9 12 8 6 8 12 -64 0 -5 2 1 2 -64 0 -12 -9 3 -9 5 -4 2 -9 -64 -64 2056 45 -16 -9 12 -12 10 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 2 6 0 -2 -64 0 -6 12 9 12 8 6 8 12 -64 0 -5 2 1 2 -64 0 -12 -9 -5 -9 -64 -64 2057 89 -16 -9 12 -10 12 8 10 9 10 10 12 9 6 9 8 8 10 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -2 -9 0 -9 3 -8 5 -6 7 -2 -64 0 2 12 0 11 -2 9 -4 6 -5 3 -6 -1 -6 -4 -5 -7 -4 -8 -2 -9 -64 0 0 -9 2 -8 4 -6 6 -2 -64 0 3 -2 10 -2 -64 -64 2058 59 -16 -9 12 -13 13 -4 12 -10 -9 -64 0 -3 12 -9 -9 -64 0 9 12 3 -9 -64 0 10 12 4 -9 -64 0 -7 12 0 12 -64 0 6 12 13 12 -64 0 -6 2 6 2 -64 0 -13 -9 -6 -9 -64 0 0 -9 7 -9 -64 -64 2059 29 -16 -9 12 -6 7 3 12 -3 -9 -64 0 4 12 -2 -9 -64 0 0 12 7 12 -64 0 -6 -9 1 -9 -64 -64 2060 47 -16 -9 12 -9 9 6 12 1 -5 0 -7 -1 -8 -3 -9 -5 -9 -7 -8 -8 -6 -8 -4 -7 -3 -6 -4 -7 -5 -64 0 5 12 0 -5 -1 -7 -3 -9 -64 0 2 12 9 12 -64 -64 2061 59 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 11 12 -6 -1 -64 0 1 3 5 -9 -64 0 0 3 4 -9 -64 0 -6 12 1 12 -64 0 7 12 13 12 -64 0 -12 -9 -5 -9 -64 0 1 -9 7 -9 -64 -64 2062 33 -16 -9 12 -10 10 -1 12 -7 -9 -64 0 0 12 -6 -9 -64 0 -4 12 3 12 -64 0 -10 -9 5 -9 7 -3 4 -9 -64 -64 2063 65 -16 -9 12 -13 14 -4 12 -10 -9 -64 0 -4 12 -3 -9 -64 0 -3 12 -2 -7 -64 0 10 12 -3 -9 -64 0 10 12 4 -9 -64 0 11 12 5 -9 -64 0 -7 12 -3 12 -64 0 10 12 14 12 -64 0 -13 -9 -7 -9 -64 0 1 -9 8 -9 -64 -64 2064 47 -16 -9 12 -12 13 -3 12 -9 -9 -64 0 -3 12 4 -6 -64 0 -3 9 4 -9 -64 0 10 12 4 -9 -64 0 -6 12 -3 12 -64 0 7 12 13 12 -64 0 -12 -9 -6 -9 -64 -64 2065 89 -16 -9 12 -11 11 1 12 -2 11 -4 9 -6 6 -7 3 -8 -1 -8 -4 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 1 12 -64 0 1 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -4 -9 -64 0 -1 -9 1 -8 3 -6 5 -3 6 0 7 4 7 7 6 10 4 12 -64 -64 2066 59 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 6 12 9 11 10 9 10 7 9 4 7 2 3 1 -5 1 -64 0 6 12 8 11 9 9 9 7 8 4 6 2 3 1 -64 0 -12 -9 -5 -9 -64 -64 2067 127 -16 -9 12 -11 11 1 12 -2 11 -4 9 -6 6 -7 3 -8 -1 -8 -4 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 1 12 -64 0 1 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -4 -9 -64 0 -1 -9 1 -8 3 -6 5 -3 6 0 7 4 7 7 6 10 4 12 -64 0 -6 -7 -6 -6 -5 -4 -3 -3 -2 -3 0 -4 1 -6 1 -13 2 -14 4 -14 5 -12 5 -11 -64 0 1 -6 2 -12 3 -13 4 -13 5 -12 -64 -64 2068 89 -16 -9 12 -12 12 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 5 12 8 11 9 9 9 7 8 4 7 3 4 2 -5 2 -64 0 5 12 7 11 8 9 8 7 7 4 6 3 4 2 -64 0 0 2 2 1 3 0 4 -8 5 -9 7 -9 8 -7 8 -6 -64 0 3 0 5 -7 6 -8 7 -8 8 -7 -64 0 -12 -9 -5 -9 -64 -64 2069 75 -16 -9 12 -11 12 8 10 9 10 10 12 9 6 9 8 8 10 7 11 4 12 0 12 -3 11 -5 9 -5 7 -4 5 -3 4 4 0 6 -2 -64 0 -5 7 -3 5 4 1 5 0 6 -2 6 -5 5 -7 4 -8 1 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -3 -9 -9 -8 -7 -7 -7 -64 -64 2070 37 -16 -9 12 -10 11 3 12 -3 -9 -64 0 4 12 -2 -9 -64 0 -3 12 -6 6 -4 12 11 12 10 6 10 12 -64 0 -6 -9 1 -9 -64 -64 2071 55 -16 -9 12 -12 13 -4 12 -7 1 -8 -3 -8 -6 -7 -8 -4 -9 0 -9 3 -8 5 -6 6 -3 10 12 -64 0 -3 12 -6 1 -7 -3 -7 -6 -6 -8 -4 -9 -64 0 -7 12 0 12 -64 0 7 12 13 12 -64 -64 2072 35 -16 -9 12 -10 10 -4 12 -3 -9 -64 0 -3 12 -2 -7 -64 0 10 12 -3 -9 -64 0 -6 12 0 12 -64 0 6 12 12 12 -64 -64 2073 53 -16 -9 12 -13 13 -5 12 -7 -9 -64 0 -4 12 -6 -7 -64 0 3 12 -7 -9 -64 0 3 12 1 -9 -64 0 4 12 2 -7 -64 0 11 12 1 -9 -64 0 -8 12 -1 12 -64 0 8 12 14 12 -64 -64 2074 47 -16 -9 12 -11 11 -4 12 3 -9 -64 0 -3 12 4 -9 -64 0 10 12 -10 -9 -64 0 -6 12 0 12 -64 0 6 12 12 12 -64 0 -12 -9 -6 -9 -64 0 0 -9 6 -9 -64 -64 2075 45 -16 -9 12 -10 11 -4 12 0 2 -3 -9 -64 0 -3 12 1 2 -2 -9 -64 0 11 12 1 2 -64 0 -6 12 0 12 -64 0 7 12 13 12 -64 0 -6 -9 1 -9 -64 -64 2076 37 -16 -9 12 -11 11 9 12 -10 -9 -64 0 10 12 -9 -9 -64 0 -3 12 -6 6 -4 12 10 12 -64 0 -10 -9 4 -9 6 -3 3 -9 -64 -64 2077 97 -16 -9 12 -10 10 -7 9 -6 7 6 -5 7 -7 7 -9 -64 0 -6 6 6 -6 -64 0 -7 9 -7 7 -6 5 6 -7 7 -9 -64 0 -2 2 -6 -2 -7 -4 -7 -6 -6 -8 -7 -9 -64 0 -7 -4 -5 -8 -64 0 -6 -2 -6 -4 -5 -6 -5 -8 -7 -9 -64 0 1 -1 6 4 -64 0 4 9 4 6 5 4 7 4 7 6 5 7 4 9 -64 0 4 9 5 6 7 4 -64 -64 2078 69 -16 -9 12 -10 10 -1 9 -7 -9 -64 0 1 9 7 -9 -64 0 0 9 6 -9 -64 0 -5 -3 4 -3 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 0 -1 16 -3 15 -4 13 -4 11 -3 9 -1 8 1 8 3 9 4 11 4 13 3 15 1 16 -1 16 -64 -64 2101 83 -16 -9 12 -9 11 -4 3 -4 2 -5 2 -5 3 -4 4 -2 5 2 5 4 4 5 3 6 1 6 -6 7 -8 8 -9 -64 0 5 3 5 -6 6 -8 8 -9 9 -9 -64 0 5 1 4 0 -2 -1 -5 -2 -6 -4 -6 -6 -5 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 -2 -1 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 -64 -64 2102 71 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -5 2 -3 4 -1 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -1 -9 -3 -8 -5 -6 -64 0 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -64 0 -9 12 -5 12 -64 -64 2103 61 -16 -9 12 -10 9 5 2 4 1 5 0 6 1 6 2 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 -64 2104 77 -16 -9 12 -10 11 5 12 5 -9 -64 0 6 12 6 -9 -64 0 5 2 3 4 1 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 3 -8 5 -6 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 2 12 6 12 -64 0 5 -9 9 -9 -64 -64 2105 67 -16 -9 12 -10 9 -6 -1 6 -1 6 1 5 3 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 5 -1 5 2 4 4 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 -64 2106 49 -16 -9 12 -7 6 3 11 2 10 3 9 4 10 4 11 3 12 1 12 -1 11 -2 9 -2 -9 -64 0 1 12 0 11 -1 9 -1 -9 -64 0 -5 5 3 5 -64 0 -5 -9 2 -9 -64 -64 2107 125 -16 -9 12 -9 10 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 -3 -4 -1 -5 1 -5 3 -4 4 -3 5 -1 5 1 4 3 3 4 1 5 -1 5 -64 0 -3 4 -4 2 -4 -2 -3 -4 -64 0 3 -4 4 -2 4 2 3 4 -64 0 4 3 5 4 7 5 7 4 5 4 -64 0 -4 -3 -5 -4 -6 -6 -6 -7 -5 -9 -2 -10 3 -10 6 -11 7 -12 -64 0 -6 -7 -5 -8 -2 -9 3 -9 6 -10 7 -12 7 -13 6 -15 3 -16 -3 -16 -6 -15 -7 -13 -7 -12 -6 -10 -3 -9 -64 -64 2108 61 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -5 2 -3 4 0 5 2 5 5 4 6 2 6 -9 -64 0 2 5 4 4 5 2 5 -9 -64 0 -9 12 -5 12 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2109 41 -16 -9 12 -5 6 0 12 -1 11 0 10 1 11 0 12 -64 0 0 5 0 -9 -64 0 1 5 1 -9 -64 0 -3 5 1 5 -64 0 -3 -9 4 -9 -64 -64 2110 55 -16 -9 12 -5 6 1 12 0 11 1 10 2 11 1 12 -64 0 2 5 2 -13 1 -15 -1 -16 -3 -16 -4 -15 -4 -14 -3 -13 -2 -14 -3 -15 -64 0 1 5 1 -13 0 -15 -1 -16 -64 0 -2 5 2 5 -64 -64 2111 59 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 5 5 -5 -5 -64 0 0 -1 6 -9 -64 0 -1 -1 5 -9 -64 0 -9 12 -5 12 -64 0 2 5 8 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 8 -9 -64 -64 2112 29 -16 -9 12 -5 6 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -3 12 1 12 -64 0 -3 -9 4 -9 -64 -64 2113 93 -16 -9 12 -16 17 -11 5 -11 -9 -64 0 -10 5 -10 -9 -64 0 -10 2 -8 4 -5 5 -3 5 0 4 1 2 1 -9 -64 0 -3 5 -1 4 0 2 0 -9 -64 0 1 2 3 4 6 5 8 5 11 4 12 2 12 -9 -64 0 8 5 10 4 11 2 11 -9 -64 0 -14 5 -10 5 -64 0 -14 -9 -7 -9 -64 0 -3 -9 4 -9 -64 0 8 -9 15 -9 -64 -64 2114 61 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 -5 2 -3 4 0 5 2 5 5 4 6 2 6 -9 -64 0 2 5 4 4 5 2 5 -9 -64 0 -9 5 -5 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2115 77 -16 -9 12 -10 10 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 1 5 -1 5 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -3 6 -1 5 2 3 4 1 5 -64 -64 2116 77 -16 -9 12 -11 10 -6 5 -6 -16 -64 0 -5 5 -5 -16 -64 0 -5 2 -3 4 -1 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -1 -9 -3 -8 -5 -6 -64 0 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -64 0 -9 5 -5 5 -64 0 -9 -16 -2 -16 -64 -64 2117 71 -16 -9 12 -10 10 5 5 5 -16 -64 0 6 5 6 -16 -64 0 5 2 3 4 1 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 3 -8 5 -6 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 2 -16 9 -16 -64 -64 2118 51 -16 -9 12 -9 8 -4 5 -4 -9 -64 0 -3 5 -3 -9 -64 0 -3 -1 -2 2 0 4 2 5 5 5 6 4 6 3 5 2 4 3 5 4 -64 0 -7 5 -3 5 -64 0 -7 -9 0 -9 -64 -64 2119 69 -16 -9 12 -8 9 5 3 6 5 6 1 5 3 4 4 2 5 -2 5 -4 4 -5 3 -5 1 -4 0 -2 -1 3 -3 5 -4 6 -5 -64 0 -5 2 -4 1 -2 0 3 -2 5 -3 6 -4 6 -7 5 -8 3 -9 -1 -9 -3 -8 -4 -7 -5 -5 -5 -9 -4 -7 -64 -64 2120 37 -16 -9 12 -7 8 -2 12 -2 -5 -1 -8 1 -9 3 -9 5 -8 6 -6 -64 0 -1 12 -1 -5 0 -8 1 -9 -64 0 -5 5 3 5 -64 -64 2121 61 -16 -9 12 -11 11 -6 5 -6 -6 -5 -8 -2 -9 0 -9 3 -8 5 -6 -64 0 -5 5 -5 -6 -4 -8 -2 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -5 5 -64 0 2 5 6 5 -64 0 5 -9 9 -9 -64 -64 2122 35 -16 -9 12 -9 9 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 6 5 0 -9 -64 0 -8 5 -2 5 -64 0 2 5 8 5 -64 -64 2123 53 -16 -9 12 -12 12 -8 5 -4 -9 -64 0 -7 5 -4 -6 -64 0 0 5 -4 -9 -64 0 0 5 4 -9 -64 0 1 5 4 -6 -64 0 8 5 4 -9 -64 0 -11 5 -4 5 -64 0 5 5 11 5 -64 -64 2124 47 -16 -9 12 -10 10 -6 5 5 -9 -64 0 -5 5 6 -9 -64 0 6 5 -6 -9 -64 0 -8 5 -2 5 -64 0 2 5 8 5 -64 0 -8 -9 -2 -9 -64 0 2 -9 8 -9 -64 -64 2125 49 -16 -9 12 -10 9 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 6 5 0 -9 -2 -13 -4 -15 -6 -16 -7 -16 -8 -15 -7 -14 -6 -15 -64 0 -8 5 -2 5 -64 0 2 5 8 5 -64 -64 2126 37 -16 -9 12 -9 9 5 5 -6 -9 -64 0 6 5 -5 -9 -64 0 -5 5 -6 1 -6 5 6 5 -64 0 -6 -9 6 -9 6 -5 5 -9 -64 -64 2127 85 -16 -9 12 -11 12 -1 5 -4 4 -6 2 -7 0 -8 -3 -8 -6 -7 -8 -4 -9 -2 -9 0 -8 3 -5 5 -2 7 2 8 5 -64 0 -1 5 -3 4 -5 2 -6 0 -7 -3 -7 -6 -6 -8 -4 -9 -64 0 -1 5 1 5 3 4 4 2 6 -6 7 -8 8 -9 -64 0 1 5 2 4 3 2 5 -6 6 -8 8 -9 9 -9 -64 -64 2128 119 -16 -9 12 -11 10 2 12 -1 11 -3 9 -5 5 -6 2 -7 -2 -8 -8 -9 -16 -64 0 2 12 0 11 -2 9 -4 5 -5 2 -6 -2 -7 -8 -8 -16 -64 0 2 12 4 12 6 11 7 10 7 7 6 5 5 4 2 3 -2 3 -64 0 4 12 6 10 6 7 5 5 4 4 2 3 -64 0 -2 3 2 2 4 0 5 -2 5 -5 4 -7 3 -8 0 -9 -2 -9 -4 -8 -5 -7 -6 -4 -64 0 -2 3 1 2 3 0 4 -2 4 -5 3 -7 2 -8 0 -9 -64 -64 2129 61 -16 -9 12 -10 10 -9 2 -7 4 -5 5 -3 5 -1 4 0 3 1 0 1 -4 0 -8 -3 -16 -64 0 -8 3 -6 4 -2 4 0 3 -64 0 8 5 7 2 6 0 1 -7 -2 -12 -4 -16 -64 0 7 5 6 2 5 0 1 -7 -64 -64 2130 93 -16 -9 12 -9 10 4 4 2 5 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 6 -2 6 1 5 3 1 8 0 10 0 12 1 13 3 13 5 12 7 10 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 0 0 -9 2 -8 4 -5 5 -2 5 2 4 4 2 7 1 9 1 11 2 12 4 12 7 10 -64 -64 2131 69 -16 -9 12 -9 9 6 2 4 4 2 5 -2 5 -4 4 -4 2 -2 0 1 -1 -64 0 -2 5 -3 4 -3 2 -1 0 1 -1 -64 0 1 -1 -4 -2 -6 -4 -6 -6 -5 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 1 -1 -3 -2 -5 -4 -5 -6 -4 -8 -2 -9 -64 -64 2132 67 -16 -9 12 -9 9 2 12 0 11 -1 10 -1 9 0 8 3 7 8 7 8 8 5 7 1 5 -2 3 -5 0 -6 -3 -6 -5 -5 -7 -2 -9 1 -11 2 -13 2 -15 1 -16 -1 -16 -2 -15 -64 0 3 6 -1 3 -4 0 -5 -3 -5 -5 -4 -7 -2 -9 -64 -64 2133 69 -16 -9 12 -11 11 -10 1 -9 3 -7 5 -4 5 -3 4 -3 2 -4 -2 -6 -9 -64 0 -5 5 -4 4 -4 2 -5 -2 -7 -9 -64 0 -4 -2 -2 2 0 4 2 5 4 5 6 4 7 3 7 0 6 -5 3 -16 -64 0 4 5 6 3 6 0 5 -5 2 -16 -64 -64 2134 93 -16 -9 12 -12 11 -11 1 -10 3 -8 5 -5 5 -4 4 -4 2 -5 -3 -5 -6 -4 -8 -3 -9 -64 0 -6 5 -5 4 -5 2 -6 -3 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 3 -6 5 -3 6 0 7 5 7 9 6 11 4 12 2 12 0 10 0 8 1 5 3 2 5 0 8 -2 -64 0 1 -8 3 -5 4 -3 5 0 6 5 6 9 5 11 4 12 -64 -64 2135 35 -16 -9 12 -6 6 0 5 -2 -2 -3 -6 -3 -8 -2 -9 1 -9 3 -7 4 -5 -64 0 1 5 -1 -2 -2 -6 -2 -8 -1 -9 -64 -64 2136 63 -16 -9 12 -10 10 -4 5 -8 -9 -64 0 -3 5 -7 -9 -64 0 6 5 7 4 8 4 7 5 5 5 3 4 -1 0 -3 -1 -5 -1 -64 0 -3 -1 -1 -2 1 -8 2 -9 -64 0 -3 -1 -2 -2 0 -8 1 -9 3 -9 5 -8 7 -5 -64 -64 2137 51 -16 -9 12 -10 10 -7 12 -5 12 -3 11 -2 10 -1 8 5 -6 6 -8 7 -9 -64 0 -5 12 -3 10 -2 8 4 -6 5 -8 7 -9 8 -9 -64 0 0 5 -8 -9 -64 0 0 5 -7 -9 -64 -64 2138 61 -16 -9 12 -12 11 -5 5 -11 -16 -64 0 -4 5 -10 -16 -64 0 -5 2 -6 -4 -6 -7 -4 -9 -2 -9 0 -8 2 -6 4 -3 -64 0 6 5 3 -6 3 -8 4 -9 7 -9 9 -7 10 -5 -64 0 7 5 4 -6 4 -8 5 -9 -64 -64 2139 53 -16 -9 12 -10 10 -4 5 -6 -9 -64 0 -3 5 -4 -1 -5 -6 -6 -9 -64 0 7 5 6 1 4 -3 -64 0 8 5 7 2 6 0 4 -3 2 -5 -1 -7 -3 -8 -6 -9 -64 0 -7 5 -3 5 -64 -64 2140 95 -16 -9 12 -9 8 2 12 0 11 -1 10 -1 9 0 8 3 7 6 7 -64 0 3 7 -1 6 -3 5 -4 3 -4 1 -2 -1 1 -2 4 -2 -64 0 3 7 0 6 -2 5 -3 3 -3 1 -1 -1 1 -2 -64 0 1 -2 -3 -3 -5 -4 -6 -6 -6 -8 -4 -10 1 -12 2 -13 2 -15 0 -16 -2 -16 -64 0 1 -2 -2 -3 -4 -4 -5 -6 -5 -8 -3 -10 1 -12 -64 -64 2141 69 -16 -9 12 -9 9 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 6 -2 6 1 5 3 4 4 2 5 0 5 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 0 0 -9 2 -8 4 -5 5 -2 5 2 4 4 -64 -64 2142 49 -16 -9 12 -11 11 -2 4 -6 -9 -64 0 -2 4 -5 -9 -64 0 4 4 4 -9 -64 0 4 4 5 -9 -64 0 -9 2 -7 4 -4 5 9 5 -64 0 -9 2 -7 3 -4 4 9 4 -64 -64 2143 67 -16 -9 12 -10 9 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 6 -2 6 1 5 3 4 4 2 5 0 5 -3 4 -5 1 -6 -2 -10 -16 -64 0 0 -9 2 -8 4 -5 5 -2 5 2 4 4 -64 0 0 5 -2 4 -4 1 -5 -2 -9 -16 -64 -64 2144 75 -16 -9 12 -10 11 9 5 -1 5 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -5 5 -2 5 1 4 3 3 4 1 5 -64 0 -1 5 -3 4 -5 1 -6 -2 -6 -6 -5 -8 -64 0 -1 -9 1 -8 3 -5 4 -2 4 2 3 4 -64 0 3 4 9 4 -64 -64 2145 37 -16 -9 12 -10 10 1 4 -2 -9 -64 0 1 4 -1 -9 -64 0 -8 2 -6 4 -3 5 8 5 -64 0 -8 2 -6 3 -3 4 8 4 -64 -64 2146 67 -16 -9 12 -10 10 -9 1 -8 3 -6 5 -3 5 -2 4 -2 2 -4 -4 -4 -7 -2 -9 -64 0 -4 5 -3 4 -3 2 -5 -4 -5 -7 -4 -8 -2 -9 -1 -9 2 -8 4 -6 6 -3 7 0 7 3 6 5 5 4 6 3 7 0 -64 0 6 -3 7 3 -64 -64 2147 79 -16 -9 12 -11 11 -3 4 -5 3 -7 1 -8 -2 -8 -5 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 5 -6 7 -3 8 0 8 3 6 5 4 5 2 3 0 -1 -2 -6 -5 -16 -64 0 -8 -5 -6 -7 -4 -8 -1 -8 2 -7 5 -5 7 -3 -64 0 8 3 6 4 4 4 2 2 0 -1 -2 -7 -4 -16 -64 -64 2148 51 -16 -9 12 -9 9 -7 5 -5 5 -3 4 -2 2 3 -13 4 -15 5 -16 -64 0 -5 5 -4 4 -3 2 2 -13 3 -15 5 -16 7 -16 -64 0 8 5 7 3 5 0 -5 -11 -7 -14 -8 -16 -64 -64 2149 73 -16 -9 12 -12 11 3 12 -3 -16 -64 0 4 12 -4 -16 -64 0 -11 1 -10 3 -8 5 -5 5 -4 4 -4 2 -5 -3 -5 -6 -3 -8 0 -8 2 -7 5 -4 7 -1 -64 0 -6 5 -5 4 -5 2 -6 -3 -6 -6 -5 -8 -3 -9 0 -9 2 -8 4 -6 6 -3 7 -1 9 5 -64 -64 2150 93 -16 -9 12 -12 11 -8 1 -6 3 -3 4 -4 5 -6 4 -8 1 -9 -2 -9 -5 -8 -8 -7 -9 -5 -9 -3 -8 -1 -5 0 -2 -64 0 -9 -5 -8 -7 -7 -8 -5 -8 -3 -7 -1 -5 -64 0 -1 -2 -1 -5 0 -8 1 -9 3 -9 5 -8 7 -5 8 -2 8 1 7 4 6 5 5 4 7 3 8 1 -64 0 -1 -5 0 -7 1 -8 3 -8 5 -7 7 -5 -64 -64 2151 83 -16 -9 12 -10 11 6 5 4 -2 3 -6 3 -8 4 -9 7 -9 9 -7 10 -5 -64 0 7 5 5 -2 4 -6 4 -8 5 -9 -64 0 4 -2 4 1 3 4 1 5 -1 5 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 3 -5 4 -2 -64 0 -1 5 -3 4 -5 1 -6 -2 -6 -6 -5 -8 -64 -64 2152 77 -16 -9 12 -10 9 -2 12 -6 -1 -6 -4 -5 -7 -4 -8 -64 0 -1 12 -5 -1 -64 0 -5 -1 -4 2 -2 4 0 5 2 5 4 4 5 3 6 1 6 -2 5 -5 3 -8 0 -9 -2 -9 -4 -8 -5 -5 -5 -1 -64 0 4 4 5 2 5 -2 4 -5 2 -8 0 -9 -64 0 -5 12 -1 12 -64 -64 2153 55 -16 -9 12 -9 9 5 2 5 1 6 1 6 2 5 4 3 5 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 -64 2154 89 -16 -9 12 -10 11 8 12 4 -2 3 -6 3 -8 4 -9 7 -9 9 -7 10 -5 -64 0 9 12 5 -2 4 -6 4 -8 5 -9 -64 0 4 -2 4 1 3 4 1 5 -1 5 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 3 -5 4 -2 -64 0 -1 5 -3 4 -5 1 -6 -2 -6 -6 -5 -8 -64 0 5 12 9 12 -64 -64 2155 57 -16 -9 12 -9 9 -5 -4 -1 -3 2 -2 5 0 6 2 5 4 3 5 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -6 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 -64 2156 75 -16 -9 12 -7 8 8 11 7 10 8 9 9 10 9 11 8 12 6 12 4 11 3 10 2 8 1 5 -2 -9 -3 -13 -4 -15 -64 0 6 12 4 10 3 8 2 4 0 -5 -1 -9 -2 -12 -3 -14 -4 -15 -6 -16 -8 -16 -9 -15 -9 -14 -8 -13 -7 -14 -8 -15 -64 0 -3 5 7 5 -64 -64 2157 91 -16 -9 12 -10 10 7 5 3 -9 2 -12 0 -15 -3 -16 -6 -16 -8 -15 -9 -14 -9 -13 -8 -12 -7 -13 -8 -14 -64 0 6 5 2 -9 1 -12 -1 -15 -3 -16 -64 0 4 -2 4 1 3 4 1 5 -1 5 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 3 -5 4 -2 -64 0 -1 5 -3 4 -5 1 -6 -2 -6 -6 -5 -8 -64 -64 2158 67 -16 -9 12 -10 11 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 -5 -2 -3 2 -1 4 1 5 3 5 5 4 6 3 6 1 4 -5 4 -8 5 -9 -64 0 3 5 5 3 5 1 3 -5 3 -8 4 -9 7 -9 9 -7 10 -5 -64 0 -5 12 -1 12 -64 -64 2159 57 -16 -9 12 -6 7 3 12 2 11 3 10 4 11 3 12 -64 0 -5 1 -4 3 -2 5 1 5 2 4 2 1 0 -5 0 -8 1 -9 -64 0 0 5 1 4 1 1 -1 -5 -1 -8 0 -9 3 -9 5 -7 6 -5 -64 -64 2160 69 -16 -9 12 -6 7 4 12 3 11 4 10 5 11 4 12 -64 0 -4 1 -3 3 -1 5 2 5 3 4 3 1 0 -9 -1 -12 -2 -14 -3 -15 -5 -16 -7 -16 -8 -15 -8 -14 -7 -13 -6 -14 -7 -15 -64 0 1 5 2 4 2 1 -1 -9 -2 -12 -3 -14 -5 -16 -64 -64 2161 73 -16 -9 12 -10 10 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 6 4 5 3 6 2 7 3 7 4 6 5 5 5 3 4 -1 0 -3 -1 -5 -1 -64 0 -3 -1 -1 -2 1 -8 2 -9 -64 0 -3 -1 -2 -2 0 -8 1 -9 3 -9 5 -8 7 -5 -64 0 -5 12 -1 12 -64 -64 2162 41 -16 -9 12 -5 7 3 12 -1 -2 -2 -6 -2 -8 -1 -9 2 -9 4 -7 5 -5 -64 0 4 12 0 -2 -1 -6 -1 -8 0 -9 -64 0 0 12 4 12 -64 -64 2163 109 -16 -9 12 -17 16 -16 1 -15 3 -13 5 -10 5 -9 4 -9 2 -10 -2 -12 -9 -64 0 -11 5 -10 4 -10 2 -11 -2 -13 -9 -64 0 -10 -2 -8 2 -6 4 -4 5 -2 5 0 4 1 3 1 1 -2 -9 -64 0 -2 5 0 3 0 1 -3 -9 -64 0 0 -2 2 2 4 4 6 5 8 5 10 4 11 3 11 1 9 -5 9 -8 10 -9 -64 0 8 5 10 3 10 1 8 -5 8 -8 9 -9 12 -9 14 -7 15 -5 -64 -64 2164 79 -16 -9 12 -12 11 -11 1 -10 3 -8 5 -5 5 -4 4 -4 2 -5 -2 -7 -9 -64 0 -6 5 -5 4 -5 2 -6 -2 -8 -9 -64 0 -5 -2 -3 2 -1 4 1 5 3 5 5 4 6 3 6 1 4 -5 4 -8 5 -9 -64 0 3 5 5 3 5 1 3 -5 3 -8 4 -9 7 -9 9 -7 10 -5 -64 -64 2165 69 -16 -9 12 -9 9 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 6 -2 6 1 5 3 4 4 2 5 0 5 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 0 0 -9 2 -8 4 -5 5 -2 5 2 4 4 -64 -64 2166 89 -16 -9 12 -11 10 -10 1 -9 3 -7 5 -4 5 -3 4 -3 2 -4 -2 -8 -16 -64 0 -5 5 -4 4 -4 2 -5 -2 -9 -16 -64 0 -4 -2 -3 1 -1 4 1 5 3 5 5 4 6 3 7 1 7 -2 6 -5 4 -8 1 -9 -1 -9 -3 -8 -4 -5 -4 -2 -64 0 5 4 6 2 6 -2 5 -5 3 -8 1 -9 -64 0 -12 -16 -5 -16 -64 -64 2167 71 -16 -9 12 -10 10 6 5 0 -16 -64 0 7 5 1 -16 -64 0 4 -2 4 1 3 4 1 5 -1 5 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 3 -5 4 -2 -64 0 -1 5 -3 4 -5 1 -6 -2 -6 -6 -5 -8 -64 0 -3 -16 4 -16 -64 -64 2168 57 -16 -9 12 -9 8 -8 1 -7 3 -5 5 -2 5 -1 4 -1 2 -2 -2 -4 -9 -64 0 -3 5 -2 4 -2 2 -3 -2 -5 -9 -64 0 -2 -2 0 2 2 4 4 5 6 5 7 4 7 3 6 2 5 3 6 4 -64 -64 2169 61 -16 -9 12 -8 9 6 3 6 2 7 2 7 3 6 4 3 5 0 5 -3 4 -4 3 -4 1 -3 0 4 -4 5 -5 -64 0 -4 2 -3 1 4 -3 5 -4 5 -7 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -6 -6 -5 -6 -5 -7 -64 -64 2170 41 -16 -9 12 -7 7 2 12 -2 -2 -3 -6 -3 -8 -2 -9 1 -9 3 -7 4 -5 -64 0 3 12 -1 -2 -2 -6 -2 -8 -1 -9 -64 0 -4 5 5 5 -64 -64 2171 79 -16 -9 12 -12 11 -11 1 -10 3 -8 5 -5 5 -4 4 -4 1 -6 -5 -6 -7 -4 -9 -64 0 -6 5 -5 4 -5 1 -7 -5 -7 -7 -6 -8 -4 -9 -2 -9 0 -8 2 -6 4 -2 -64 0 6 5 4 -2 3 -6 3 -8 4 -9 7 -9 9 -7 10 -5 -64 0 7 5 5 -2 4 -6 4 -8 5 -9 -64 -64 2172 57 -16 -9 12 -10 10 -9 1 -8 3 -6 5 -3 5 -2 4 -2 1 -4 -5 -4 -7 -2 -9 -64 0 -4 5 -3 4 -3 1 -5 -5 -5 -7 -4 -8 -2 -9 -1 -9 2 -8 4 -6 6 -3 7 1 7 5 6 5 7 3 -64 -64 2173 87 -16 -9 12 -15 14 -14 1 -13 3 -11 5 -8 5 -7 4 -7 1 -9 -5 -9 -7 -7 -9 -64 0 -9 5 -8 4 -8 1 -10 -5 -10 -7 -9 -8 -7 -9 -5 -9 -3 -8 -1 -6 0 -4 -64 0 2 5 0 -4 0 -7 1 -8 3 -9 5 -9 7 -8 9 -6 10 -4 11 0 11 5 10 5 11 3 -64 0 3 5 1 -4 1 -7 3 -9 -64 -64 2174 89 -16 -9 12 -10 10 -7 1 -5 4 -3 5 0 5 1 3 1 0 -64 0 -1 5 0 3 0 0 -1 -4 -2 -6 -4 -8 -6 -9 -7 -9 -8 -8 -8 -7 -7 -6 -6 -7 -7 -8 -64 0 -1 -4 -1 -7 0 -9 3 -9 5 -8 7 -5 -64 0 7 4 6 3 7 2 8 3 8 4 7 5 6 5 4 4 2 2 1 0 0 -4 0 -7 1 -9 -64 -64 2175 87 -16 -9 12 -11 10 -10 1 -9 3 -7 5 -4 5 -3 4 -3 1 -5 -5 -5 -7 -3 -9 -64 0 -5 5 -4 4 -4 1 -6 -5 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 3 -6 5 -2 -64 0 8 5 4 -9 3 -12 1 -15 -2 -16 -5 -16 -7 -15 -8 -14 -8 -13 -7 -12 -6 -13 -7 -14 -64 0 7 5 3 -9 2 -12 0 -15 -2 -16 -64 -64 2176 67 -16 -9 12 -10 10 7 5 6 3 4 1 -4 -5 -6 -7 -7 -9 -64 0 -6 1 -5 3 -3 5 0 5 4 3 -64 0 -5 3 -3 4 0 4 4 3 6 3 -64 0 -6 -7 -4 -7 0 -8 3 -8 5 -7 -64 0 -4 -7 0 -9 3 -9 5 -7 6 -5 -64 -64 2177 91 -16 -9 12 -11 12 4 11 3 10 4 9 5 10 5 11 3 12 0 12 -3 11 -5 9 -6 6 -6 -9 -64 0 0 12 -2 11 -4 9 -5 6 -5 -9 -64 0 10 11 9 10 10 9 11 10 11 11 10 12 8 12 6 11 5 9 5 -9 -64 0 8 12 7 11 6 9 6 -9 -64 0 -9 5 9 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2178 71 -16 -9 12 -11 11 5 11 4 10 5 9 6 10 5 11 3 12 0 12 -3 11 -5 9 -6 6 -6 -9 -64 0 0 12 -2 11 -4 9 -5 6 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 6 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2179 75 -16 -9 12 -11 11 4 11 3 10 4 9 5 10 5 11 3 12 -64 0 6 12 0 12 -3 11 -5 9 -6 6 -6 -9 -64 0 0 12 -2 11 -4 9 -5 6 -5 -9 -64 0 5 10 5 -9 -64 0 6 12 6 -9 -64 0 -9 5 5 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2180 113 -16 -9 12 -16 17 0 11 -1 10 0 9 1 10 0 11 -2 12 -5 12 -8 11 -10 9 -11 6 -11 -9 -64 0 -5 12 -7 11 -9 9 -10 6 -10 -9 -64 0 11 11 10 10 11 9 12 10 11 11 9 12 6 12 3 11 1 9 0 6 0 -9 -64 0 6 12 4 11 2 9 1 6 1 -9 -64 0 11 5 11 -9 -64 0 12 5 12 -9 -64 0 -14 5 12 5 -64 0 -14 -9 -7 -9 -64 0 -3 -9 4 -9 -64 0 8 -9 15 -9 -64 -64 2181 117 -16 -9 12 -16 17 0 11 -1 10 0 9 1 10 0 11 -2 12 -5 12 -8 11 -10 9 -11 6 -11 -9 -64 0 -5 12 -7 11 -9 9 -10 6 -10 -9 -64 0 10 11 9 10 10 9 11 10 11 11 9 12 -64 0 12 12 6 12 3 11 1 9 0 6 0 -9 -64 0 6 12 4 11 2 9 1 6 1 -9 -64 0 11 10 11 -9 -64 0 12 12 12 -9 -64 0 -14 5 11 5 -64 0 -14 -9 -7 -9 -64 0 -3 -9 4 -9 -64 0 8 -9 15 -9 -64 -64 2182 29 -16 -9 12 -5 6 0 5 0 -9 -64 0 1 5 1 -9 -64 0 -3 5 1 5 -64 0 -3 -9 4 -9 -64 -64 2184 55 -16 -9 12 -9 8 5 4 3 5 0 5 -3 4 -5 2 -6 -1 -6 -4 -5 -7 -4 -8 -1 -9 2 -9 4 -8 -64 0 0 5 -2 4 -4 2 -5 -1 -5 -4 -4 -7 -3 -8 -1 -9 -64 0 -5 -2 3 -2 -64 -64 2185 91 -16 -9 12 -9 10 2 12 -1 11 -3 8 -4 6 -5 3 -6 -2 -6 -6 -5 -8 -3 -9 -1 -9 2 -8 4 -5 5 -3 6 0 7 5 7 9 6 11 4 12 2 12 -64 0 2 12 0 11 -2 8 -3 6 -4 3 -5 -2 -5 -6 -4 -8 -3 -9 -64 0 -1 -9 1 -8 3 -5 4 -3 5 0 6 5 6 9 5 11 4 12 -64 0 -4 2 5 2 -64 -64 2186 89 -16 -9 12 -11 11 3 12 -3 -16 -64 0 4 12 -4 -16 -64 0 -1 5 -5 4 -7 2 -8 -1 -8 -4 -7 -6 -5 -8 -2 -9 1 -9 5 -8 7 -6 8 -3 8 0 7 2 5 4 2 5 -1 5 -64 0 -1 5 -4 4 -6 2 -7 -1 -7 -4 -6 -6 -4 -8 -2 -9 -64 0 1 -9 4 -8 6 -6 7 -3 7 0 6 2 4 4 2 5 -64 -64 2187 59 -16 -9 12 -9 9 2 5 4 4 6 2 6 3 5 4 2 5 -1 5 -4 4 -5 3 -6 1 -6 -1 -5 -3 -3 -5 1 -8 -64 0 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 1 -8 2 -10 2 -12 1 -13 -1 -13 -64 -64 2190 95 -16 -9 12 -11 11 -6 5 -7 4 -8 2 -8 0 -7 -3 -3 -7 -2 -9 -64 0 -8 0 -7 -2 -3 -6 -2 -9 -2 -11 -3 -14 -5 -16 -6 -16 -7 -15 -8 -13 -8 -10 -7 -6 -5 -2 -3 1 0 4 2 5 4 5 7 4 8 2 8 -2 7 -6 5 -8 3 -9 2 -9 1 -8 1 -6 2 -5 3 -6 2 -7 -64 0 4 5 6 4 7 2 7 -2 6 -6 5 -8 -64 -64 2191 143 -16 -9 12 -13 13 7 11 6 10 7 9 8 10 7 11 5 12 2 12 -1 11 -3 9 -4 7 -5 4 -6 0 -8 -9 -9 -13 -10 -15 -64 0 2 12 0 11 -2 9 -3 7 -4 4 -6 -5 -7 -9 -8 -12 -9 -14 -10 -15 -12 -16 -14 -16 -15 -15 -15 -14 -14 -13 -13 -14 -14 -15 -64 0 13 11 12 10 13 9 14 10 14 11 13 12 11 12 9 11 8 10 7 8 6 5 3 -9 2 -13 1 -15 -64 0 11 12 9 10 8 8 7 4 5 -5 4 -9 3 -12 2 -14 1 -15 -1 -16 -3 -16 -4 -15 -4 -14 -3 -13 -2 -14 -3 -15 -64 0 -9 5 12 5 -64 -64 2192 109 -16 -9 12 -12 12 9 11 8 10 9 9 10 10 9 11 6 12 3 12 0 11 -2 9 -3 7 -4 4 -5 0 -7 -9 -8 -13 -9 -15 -64 0 3 12 1 11 -1 9 -2 7 -3 4 -5 -5 -6 -9 -7 -12 -8 -14 -9 -15 -11 -16 -13 -16 -14 -15 -14 -14 -13 -13 -12 -14 -13 -15 -64 0 7 5 5 -2 4 -6 4 -8 5 -9 8 -9 10 -7 11 -5 -64 0 8 5 6 -2 5 -6 5 -8 6 -9 -64 0 -8 5 8 5 -64 -64 2193 113 -16 -9 12 -12 12 7 11 6 10 7 9 8 10 8 11 6 12 -64 0 10 12 3 12 0 11 -2 9 -3 7 -4 4 -5 0 -7 -9 -8 -13 -9 -15 -64 0 3 12 1 11 -1 9 -2 7 -3 4 -5 -5 -6 -9 -7 -12 -8 -14 -9 -15 -11 -16 -13 -16 -14 -15 -14 -14 -13 -13 -12 -14 -13 -15 -64 0 9 12 5 -2 4 -6 4 -8 5 -9 8 -9 10 -7 11 -5 -64 0 10 12 6 -2 5 -6 5 -8 6 -9 -64 0 -8 5 7 5 -64 -64 2194 177 -16 -9 12 -18 17 2 11 1 10 2 9 3 10 2 11 0 12 -3 12 -6 11 -8 9 -9 7 -10 4 -11 0 -13 -9 -14 -13 -15 -15 -64 0 -3 12 -5 11 -7 9 -8 7 -9 4 -11 -5 -12 -9 -13 -12 -14 -14 -15 -15 -17 -16 -19 -16 -20 -15 -20 -14 -19 -13 -18 -14 -19 -15 -64 0 14 11 13 10 14 9 15 10 14 11 11 12 8 12 5 11 3 9 2 7 1 4 0 0 -2 -9 -3 -13 -4 -15 -64 0 8 12 6 11 4 9 3 7 2 4 0 -5 -1 -9 -2 -12 -3 -14 -4 -15 -6 -16 -8 -16 -9 -15 -9 -14 -8 -13 -7 -14 -8 -15 -64 0 12 5 10 -2 9 -6 9 -8 10 -9 13 -9 15 -7 16 -5 -64 0 13 5 11 -2 10 -6 10 -8 11 -9 -64 0 -14 5 13 5 -64 -64 2195 181 -16 -9 12 -18 17 2 11 1 10 2 9 3 10 2 11 0 12 -3 12 -6 11 -8 9 -9 7 -10 4 -11 0 -13 -9 -14 -13 -15 -15 -64 0 -3 12 -5 11 -7 9 -8 7 -9 4 -11 -5 -12 -9 -13 -12 -14 -14 -15 -15 -17 -16 -19 -16 -20 -15 -20 -14 -19 -13 -18 -14 -19 -15 -64 0 12 11 11 10 12 9 13 10 13 11 11 12 -64 0 15 12 8 12 5 11 3 9 2 7 1 4 0 0 -2 -9 -3 -13 -4 -15 -64 0 8 12 6 11 4 9 3 7 2 4 0 -5 -1 -9 -2 -12 -3 -14 -4 -15 -6 -16 -8 -16 -9 -15 -9 -14 -8 -13 -7 -14 -8 -15 -64 0 14 12 10 -2 9 -6 9 -8 10 -9 13 -9 15 -7 16 -5 -64 0 15 12 11 -2 10 -6 10 -8 11 -9 -64 0 -14 5 12 5 -64 -64 2196 45 -16 -9 12 -6 7 -5 1 -4 3 -2 5 1 5 2 4 2 1 0 -5 0 -8 1 -9 -64 0 0 5 1 4 1 1 -1 -5 -1 -8 0 -9 3 -9 5 -7 6 -5 -64 -64 2197 9 -16 -9 12 0 0 -64 0 -64 -64 2198 9 -16 -9 12 -4 4 -64 0 -64 -64 2199 9 -16 -9 12 -8 8 -64 0 -64 -64 2200 85 -16 -9 12 -10 10 -1 12 -4 11 -6 8 -7 3 -7 0 -6 -5 -4 -8 -1 -9 1 -9 4 -8 6 -5 7 0 7 3 6 8 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -4 10 -5 8 -6 3 -6 0 -5 -5 -4 -7 -3 -8 -1 -9 -64 0 1 -9 3 -8 4 -7 5 -5 6 0 6 3 5 8 4 10 3 11 1 12 -64 -64 2201 27 -16 -9 12 -10 10 -4 8 -2 9 1 12 1 -9 -64 0 0 11 0 -9 -64 0 -4 -9 5 -9 -64 -64 2202 95 -16 -9 12 -10 10 -6 8 -5 7 -6 6 -7 7 -7 8 -6 10 -5 11 -2 12 2 12 5 11 6 10 7 8 7 6 6 4 3 2 -2 0 -4 -1 -6 -3 -7 -6 -7 -9 -64 0 2 12 4 11 5 10 6 8 6 6 5 4 2 2 -2 0 -64 0 -7 -7 -6 -6 -4 -6 1 -8 4 -8 6 -7 7 -6 -64 0 -4 -6 1 -9 5 -9 6 -8 7 -6 7 -4 -64 -64 2203 99 -16 -9 12 -10 10 -6 8 -5 7 -6 6 -7 7 -7 8 -6 10 -5 11 -2 12 2 12 5 11 6 9 6 6 5 4 2 3 -1 3 -64 0 2 12 4 11 5 9 5 6 4 4 2 3 -64 0 2 3 4 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -4 -6 -5 -64 0 5 1 6 -2 6 -5 5 -7 4 -8 2 -9 -64 -64 2204 31 -16 -9 12 -10 10 2 10 2 -9 -64 0 3 12 3 -9 -64 0 3 12 -8 -3 8 -3 -64 0 -1 -9 6 -9 -64 -64 2205 83 -16 -9 12 -10 10 -5 12 -7 2 -64 0 -7 2 -5 4 -2 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -4 -6 -5 -64 0 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -64 0 -5 12 5 12 -64 0 -5 11 0 11 5 12 -64 -64 2206 101 -16 -9 12 -10 10 5 9 4 8 5 7 6 8 6 9 5 11 3 12 0 12 -3 11 -5 9 -6 7 -7 3 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -2 6 1 4 3 1 4 0 4 -3 3 -5 1 -6 -2 -64 0 0 12 -2 11 -4 9 -5 7 -6 3 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -3 6 -2 5 1 3 3 1 4 -64 -64 2207 67 -16 -9 12 -10 10 -7 12 -7 6 -64 0 -7 8 -6 10 -4 12 -2 12 3 9 5 9 6 10 7 12 -64 0 -6 10 -4 11 -2 11 3 9 -64 0 7 12 7 9 6 6 2 1 1 -1 0 -4 0 -9 -64 0 6 6 1 1 0 -1 -1 -4 -1 -9 -64 -64 2208 131 -16 -9 12 -10 10 -2 12 -5 11 -6 9 -6 6 -5 4 -2 3 2 3 5 4 6 6 6 9 5 11 2 12 -2 12 -64 0 -2 12 -4 11 -5 9 -5 6 -4 4 -2 3 -64 0 2 3 4 4 5 6 5 9 4 11 2 12 -64 0 -2 3 -5 2 -6 1 -7 -1 -7 -5 -6 -7 -5 -8 -2 -9 2 -9 5 -8 6 -7 7 -5 7 -1 6 1 5 2 2 3 -64 0 -2 3 -4 2 -5 1 -6 -1 -6 -5 -5 -7 -4 -8 -2 -9 -64 0 2 -9 4 -8 5 -7 6 -5 6 -1 5 1 4 2 2 3 -64 -64 2209 101 -16 -9 12 -10 10 6 5 5 2 3 0 0 -1 -1 -1 -4 0 -6 2 -7 5 -7 6 -6 9 -4 11 -1 12 1 12 4 11 6 9 7 6 7 0 6 -4 5 -6 3 -8 0 -9 -3 -9 -5 -8 -6 -6 -6 -5 -5 -4 -4 -5 -5 -6 -64 0 -1 -1 -3 0 -5 2 -6 5 -6 6 -5 9 -3 11 -1 12 -64 0 1 12 3 11 5 9 6 6 6 0 5 -4 4 -6 2 -8 0 -9 -64 -64 2210 17 -16 -9 12 -5 5 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 2211 21 -16 -9 12 -5 5 0 -9 -1 -8 0 -7 1 -8 1 -10 0 -12 -1 -13 -64 -64 2212 29 -16 -9 12 -5 5 0 5 -1 4 0 3 1 4 0 5 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 2213 33 -16 -9 12 -5 5 0 5 -1 4 0 3 1 4 0 5 -64 0 0 -9 -1 -8 0 -7 1 -8 1 -10 0 -12 -1 -13 -64 -64 2214 35 -16 -9 12 -5 5 0 12 -1 10 0 -2 1 10 0 12 -64 0 0 10 0 4 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 2215 69 -16 -9 12 -9 9 -5 8 -4 7 -5 6 -6 7 -6 8 -5 10 -4 11 -2 12 1 12 4 11 5 10 6 8 6 6 5 4 4 3 0 1 0 -2 -64 0 1 12 3 11 4 10 5 8 5 6 4 4 2 2 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 2216 17 -16 -9 12 -4 4 0 12 -1 5 -64 0 1 12 -1 5 -64 -64 2217 29 -16 -9 12 -8 8 -4 12 -5 5 -64 0 -3 12 -5 5 -64 0 4 12 3 5 -64 0 5 12 3 5 -64 -64 2218 33 -16 -9 12 -7 7 -1 12 -3 11 -4 9 -4 7 -3 5 -1 4 1 4 3 5 4 7 4 9 3 11 1 12 -1 12 -64 -64 2219 23 -16 -9 12 -8 8 0 12 0 0 -64 0 -5 9 5 3 -64 0 5 9 -5 3 -64 -64 2220 11 -16 -9 12 -11 11 9 16 -9 -16 -64 -64 2221 45 -16 -9 12 -7 7 4 16 2 14 0 11 -2 7 -3 2 -3 -2 -2 -7 0 -11 2 -14 4 -16 -64 0 2 14 0 10 -1 7 -2 2 -2 -2 -1 -7 0 -10 2 -14 -64 -64 2222 45 -16 -9 12 -7 7 -4 16 -2 14 0 11 2 7 3 2 3 -2 2 -7 0 -11 -2 -14 -4 -16 -64 0 -2 14 0 10 1 7 2 2 2 -2 1 -7 0 -10 -2 -14 -64 -64 2223 29 -16 -9 12 -7 7 -3 16 -3 -16 -64 0 -2 16 -2 -16 -64 0 -3 16 4 16 -64 0 -3 -16 4 -16 -64 -64 2224 29 -16 -9 12 -7 7 2 16 2 -16 -64 0 3 16 3 -16 -64 0 -4 16 3 16 -64 0 -4 -16 3 -16 -64 -64 2225 57 -16 -9 12 -8 7 2 16 -1 13 -2 10 -2 8 -1 5 1 3 1 2 -3 0 1 -2 1 -3 -1 -5 -2 -8 -2 -10 -1 -13 2 -16 -64 0 0 14 -1 11 -1 7 0 4 -64 0 0 -4 -1 -7 -1 -11 0 -14 -64 -64 2226 57 -16 -9 12 -7 8 -2 16 1 13 2 10 2 8 1 5 -1 3 -1 2 3 0 -1 -2 -1 -3 1 -5 2 -8 2 -10 1 -13 -2 -16 -64 0 0 14 1 11 1 7 0 4 -64 0 0 -4 1 -7 1 -11 0 -14 -64 -64 2227 13 -16 -9 12 -7 7 3 16 -4 0 3 -16 -64 -64 2228 13 -16 -9 12 -7 7 -3 16 4 0 -3 -16 -64 -64 2229 11 -16 -9 12 -4 4 0 16 0 -16 -64 -64 2230 17 -16 -9 12 -7 7 -3 16 -3 -16 -64 0 3 16 3 -16 -64 -64 2231 11 -16 -9 12 -13 13 -9 0 9 0 -64 -64 2232 17 -16 -9 12 -13 13 0 9 0 -9 -64 0 -9 0 9 0 -64 -64 2233 23 -16 -9 12 -12 12 0 8 0 -9 -64 0 -8 0 8 0 -64 0 -8 -9 8 -9 -64 -64 2234 23 -16 -9 12 -12 12 0 8 0 -9 -64 0 -8 8 8 8 -64 0 -8 0 8 0 -64 -64 2235 17 -16 -9 12 -11 11 -7 7 7 -7 -64 0 7 7 -7 -7 -64 -64 2236 17 -16 -9 12 -5 5 0 1 -1 0 0 -1 1 0 0 1 -64 -64 2237 35 -16 -9 12 -13 13 0 9 -1 8 0 7 1 8 0 9 -64 0 -9 0 9 0 -64 0 0 -7 -1 -8 0 -9 1 -8 0 -7 -64 -64 2238 17 -16 -9 12 -13 13 -9 3 9 3 -64 0 -9 -3 9 -3 -64 -64 2239 23 -16 -9 12 -13 13 7 9 -7 -9 -64 0 -9 3 9 3 -64 0 -9 -3 9 -3 -64 -64 2240 23 -16 -9 12 -13 13 -9 5 9 5 -64 0 -9 0 9 0 -64 0 -9 -5 9 -5 -64 -64 2241 13 -16 -9 12 -12 12 8 9 -8 0 8 -9 -64 -64 2242 13 -16 -9 12 -12 12 -8 9 8 0 -8 -9 -64 -64 2243 25 -16 -9 12 -12 12 8 12 -8 5 8 -2 -64 0 -8 -4 8 -4 -64 0 -8 -9 8 -9 -64 -64 2244 25 -16 -9 12 -12 12 -8 12 8 5 -8 -2 -64 0 -8 -4 8 -4 -64 0 -8 -9 8 -9 -64 -64 2245 47 -16 -9 12 -12 13 9 -5 7 -5 5 -4 3 -2 0 2 -1 3 -3 4 -5 4 -7 3 -8 1 -8 -1 -7 -3 -5 -4 -3 -4 -1 -3 0 -2 3 2 5 4 7 5 9 5 -64 -64 2246 53 -16 -9 12 -12 12 -9 -3 -9 -1 -8 2 -6 3 -4 3 -2 2 2 -1 4 -2 6 -2 8 -1 9 1 -64 0 -9 -1 -8 1 -6 2 -4 2 -2 1 2 -2 4 -3 6 -3 8 -2 9 1 9 3 -64 -64 2247 21 -16 -9 12 -11 11 -8 -2 0 3 8 -2 -64 0 -8 -2 0 2 8 -2 -64 -64 2248 19 -16 -9 12 -6 6 2 12 -3 6 -64 0 2 12 3 11 -3 6 -64 -64 2249 19 -16 -9 12 -6 6 -2 12 3 6 -64 0 -2 12 -3 11 3 6 -64 -64 2250 41 -16 -9 12 -10 10 -7 12 -6 10 -4 8 -1 7 1 7 4 8 6 10 7 12 -64 0 -7 12 -6 9 -4 7 -1 6 1 6 4 7 6 9 7 12 -64 -64 2251 21 -16 -9 12 -5 5 0 10 -1 11 0 12 1 11 1 9 0 7 -1 6 -64 -64 2252 21 -16 -9 12 -5 5 1 12 0 11 -1 9 -1 7 0 6 1 7 0 8 -64 -64 2253 21 -16 -9 12 -5 5 0 10 1 11 0 12 -1 11 -1 9 0 7 1 6 -64 -64 2254 21 -16 -9 12 -5 5 -1 12 0 11 1 9 1 7 0 6 -1 7 0 8 -64 -64 2255 25 -16 -9 12 -13 9 -10 5 -6 5 0 -7 -64 0 -7 5 0 -9 -64 0 9 16 0 -9 -64 -64 2256 31 -16 -9 12 -12 12 8 8 1 8 -3 7 -5 6 -7 4 -8 1 -8 -1 -7 -4 -5 -6 -3 -7 1 -8 8 -8 -64 -64 2257 31 -16 -9 12 -12 12 -8 8 -8 1 -7 -3 -6 -5 -4 -7 -1 -8 1 -8 4 -7 6 -5 7 -3 8 1 8 8 -64 -64 2258 31 -16 -9 12 -12 12 -8 8 -1 8 3 7 5 6 7 4 8 1 8 -1 7 -4 5 -6 3 -7 -1 -8 -8 -8 -64 -64 2259 31 -16 -9 12 -12 12 -8 -8 -8 -1 -7 3 -6 5 -4 7 -1 8 1 8 4 7 6 5 7 3 8 -1 8 -8 -64 -64 2260 37 -16 -9 12 -12 12 8 8 1 8 -3 7 -5 6 -7 4 -8 1 -8 -1 -7 -4 -5 -6 -3 -7 1 -8 8 -8 -64 0 -8 0 4 0 -64 -64 2261 27 -16 -9 12 -13 13 6 2 9 0 6 -2 -64 0 3 5 8 0 3 -5 -64 0 -9 0 8 0 -64 -64 2262 27 -16 -9 12 -8 8 -2 6 0 9 2 6 -64 0 -5 3 0 8 5 3 -64 0 0 8 0 -9 -64 -64 2263 27 -16 -9 12 -13 13 -6 2 -9 0 -6 -2 -64 0 -3 5 -8 0 -3 -5 -64 0 -8 0 9 0 -64 -64 2264 27 -16 -9 12 -8 8 -2 -6 0 -9 2 -6 -64 0 -5 -3 0 -8 5 -3 -64 0 0 9 0 -8 -64 -64 2265 93 -16 -9 12 -9 10 6 0 5 3 4 4 2 5 0 5 -3 4 -5 1 -6 -2 -6 -5 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -6 6 -3 7 2 7 7 6 10 5 11 3 12 0 12 -2 11 -3 10 -3 9 -2 9 -2 10 -64 0 0 5 -2 4 -4 1 -5 -2 -5 -6 -4 -8 -64 0 0 -9 2 -8 4 -6 5 -3 6 2 6 7 5 10 3 12 -64 -64 2266 35 -16 -9 12 -10 10 -8 12 0 -9 -64 0 -7 12 0 -7 -64 0 8 12 0 -9 -64 0 -8 12 8 12 -64 0 -7 11 7 11 -64 -64 2267 25 -16 -9 12 -17 16 -14 5 -9 5 0 -7 -64 0 -10 4 0 -9 -64 0 16 24 0 -9 -64 -64 2268 69 -16 -9 12 -12 12 9 15 8 14 9 13 10 14 10 15 9 16 7 16 5 15 3 13 2 11 1 8 0 4 -2 -8 -3 -12 -4 -14 -64 0 4 14 3 12 2 8 0 -4 -1 -8 -2 -11 -3 -13 -5 -15 -7 -16 -9 -16 -10 -15 -10 -14 -9 -13 -8 -14 -9 -15 -64 -64 2269 105 -16 -9 12 -12 12 9 15 8 14 9 13 10 14 10 15 9 16 7 16 5 15 3 13 2 11 1 8 0 4 -2 -8 -3 -12 -4 -14 -64 0 4 14 3 12 2 8 0 -4 -1 -8 -2 -11 -3 -13 -5 -15 -7 -16 -9 -16 -10 -15 -10 -14 -9 -13 -8 -14 -9 -15 -64 0 -1 7 -4 6 -6 4 -7 1 -7 -1 -6 -4 -4 -6 -1 -7 1 -7 4 -6 6 -4 7 -1 7 1 6 4 4 6 1 7 -1 7 -64 -64 2270 57 -16 -9 12 -12 13 10 -1 9 -3 7 -4 5 -4 3 -3 2 -2 -1 2 -2 3 -4 4 -6 4 -8 3 -9 1 -9 -1 -8 -3 -6 -4 -4 -4 -2 -3 -1 -2 2 2 3 3 5 4 7 4 9 3 10 1 10 -1 -64 -64 2271 69 -16 -9 12 -12 12 9 12 -9 -9 -64 0 -4 12 -2 10 -2 8 -3 6 -5 5 -7 5 -9 7 -9 9 -8 11 -6 12 -4 12 -2 11 1 10 4 10 7 11 9 12 -64 0 5 -2 3 -3 2 -5 2 -7 4 -9 6 -9 8 -8 9 -6 9 -4 7 -2 5 -2 -64 -64 2272 103 -16 -9 12 -12 13 9 4 8 3 9 2 10 3 10 4 9 5 8 5 7 4 6 2 4 -3 2 -6 0 -8 -2 -9 -5 -9 -8 -8 -9 -6 -9 -3 -8 -1 -2 3 0 5 1 7 1 9 0 11 -2 12 -4 11 -5 9 -5 7 -4 4 -2 1 3 -6 5 -8 8 -9 9 -9 10 -8 10 -7 -64 0 -5 -9 -7 -8 -8 -6 -8 -3 -7 -1 -5 1 -64 0 -5 7 -4 5 4 -6 6 -8 8 -9 -64 -64 2273 117 -16 -9 12 -13 14 5 4 4 6 2 7 -1 7 -3 6 -4 5 -5 2 -5 -1 -4 -3 -2 -4 1 -4 3 -3 4 -1 -64 0 -1 7 -3 5 -4 2 -4 -1 -3 -3 -2 -4 -64 0 5 7 4 -1 4 -3 6 -4 8 -4 10 -2 11 1 11 3 10 6 9 8 7 10 5 11 2 12 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 2 -9 5 -8 7 -7 8 -6 -64 0 6 7 5 -1 5 -3 6 -4 -64 -64 2274 89 -16 -9 12 -10 10 -2 16 -2 -13 -64 0 2 16 2 -13 -64 0 6 9 5 8 6 7 7 8 7 9 5 11 2 12 -2 12 -5 11 -7 9 -7 7 -6 5 -5 4 -3 3 3 1 5 0 7 -2 -64 0 -7 7 -5 5 -3 4 3 2 5 1 6 0 7 -2 7 -6 5 -8 2 -9 -2 -9 -5 -8 -7 -6 -7 -5 -6 -4 -5 -5 -6 -6 -64 -64 2275 29 -16 -9 12 -10 11 1 12 -6 -16 -64 0 7 12 0 -16 -64 0 -6 1 8 1 -64 0 -7 -5 7 -5 -64 -64 2276 97 -16 -9 12 -8 8 3 9 2 8 3 7 4 8 4 9 3 11 1 12 -1 12 -3 11 -4 9 -4 7 -3 5 -1 3 4 0 -64 0 -3 5 2 2 4 0 5 -2 5 -4 4 -6 2 -8 -64 0 -2 4 -4 2 -5 0 -5 -2 -4 -4 -2 -6 3 -9 -64 0 -4 -4 1 -7 3 -9 4 -11 4 -13 3 -15 1 -16 -1 -16 -3 -15 -4 -13 -4 -12 -3 -11 -2 -12 -3 -13 -64 -64 2277 65 -16 -9 12 -8 8 0 12 -1 10 0 8 1 10 0 12 -64 0 0 12 0 -16 -64 0 0 1 -1 -2 0 -16 1 -2 0 1 -64 0 -6 5 -4 4 -2 5 -4 6 -6 5 -64 0 -6 5 6 5 -64 0 2 5 4 4 6 5 4 6 2 5 -64 -64 2278 117 -16 -9 12 -8 8 0 12 -1 10 0 8 1 10 0 12 -64 0 0 12 0 -2 -64 0 0 2 -1 0 1 -4 0 -6 -1 -4 1 0 0 2 -64 0 0 -2 0 -16 -64 0 0 -12 -1 -14 0 -16 1 -14 0 -12 -64 0 -6 5 -4 4 -2 5 -4 6 -6 5 -64 0 -6 5 6 5 -64 0 2 5 4 4 6 5 4 6 2 5 -64 0 -6 -9 -4 -10 -2 -9 -4 -8 -6 -9 -64 0 -6 -9 6 -9 -64 0 2 -9 4 -10 6 -9 4 -8 2 -9 -64 -64 2279 29 -16 -9 12 -9 10 6 12 6 -9 -64 0 -7 12 6 12 -64 0 -2 2 6 2 -64 0 -7 -9 6 -9 -64 -64 2281 81 -16 -9 12 -13 14 -1 12 -4 11 -7 9 -9 6 -10 3 -10 0 -9 -3 -7 -6 -4 -8 -1 -9 2 -9 5 -8 8 -6 10 -3 11 0 11 3 10 6 8 9 5 11 2 12 -1 12 -64 0 0 3 -1 2 -1 1 0 0 1 0 2 1 2 2 1 3 0 3 -64 0 0 2 0 1 1 1 1 2 0 2 -64 -64 2282 95 -16 -9 12 -8 9 -2 12 -4 11 -3 9 -1 8 -64 0 -2 12 -3 11 -3 9 -64 0 3 12 5 11 4 9 2 8 -64 0 3 12 4 11 4 9 -64 0 -1 8 -3 7 -4 6 -5 4 -5 1 -4 -1 -3 -2 -1 -3 2 -3 4 -2 5 -1 6 1 6 4 5 6 4 7 2 8 -1 8 -64 0 0 -3 0 -9 -64 0 1 -3 1 -9 -64 0 -4 -6 5 -6 -64 -64 2283 59 -16 -9 12 -9 10 0 12 -3 11 -5 9 -6 6 -6 5 -5 2 -3 0 0 -1 1 -1 4 0 6 2 7 5 7 6 6 9 4 11 1 12 0 12 -64 0 0 -1 0 -9 -64 0 1 -1 1 -9 -64 0 -4 -5 5 -5 -64 -64 2284 61 -16 -9 12 -14 14 -2 12 -5 11 -8 9 -10 6 -11 3 -11 -1 -10 -4 -8 -7 -5 -9 -2 -10 2 -10 5 -9 8 -7 10 -4 11 -1 11 3 10 6 8 9 5 11 2 12 -2 12 -64 0 0 12 0 -10 -64 0 -11 1 11 1 -64 -64 2285 67 -16 -9 12 -11 14 -2 5 -5 4 -7 2 -8 -1 -8 -2 -7 -5 -5 -7 -2 -8 -1 -8 2 -7 4 -5 5 -2 5 -1 4 2 2 4 -1 5 -2 5 -64 0 11 11 5 11 9 10 3 4 -64 0 11 11 11 5 10 9 4 3 -64 0 10 10 4 4 -64 -64 2286 61 -16 -9 12 -12 10 -9 9 -8 11 -6 12 -3 12 -1 11 0 9 0 6 -1 3 -2 1 -4 -1 -7 -3 -64 0 -3 12 -2 11 -1 9 -1 5 -2 2 -4 -1 -64 0 4 12 2 -9 -64 0 5 12 1 -9 -64 0 -7 -3 7 -3 -64 -64 2287 65 -16 -9 12 -9 10 -5 12 -5 -3 -64 0 -4 12 -5 1 -64 0 -5 1 -4 3 -3 4 -1 5 2 5 5 4 6 2 6 0 5 -2 3 -4 -64 0 2 5 4 4 5 2 5 0 2 -6 2 -8 3 -9 5 -9 7 -7 -64 0 -7 12 -4 12 -64 -64 2288 93 -16 -9 12 -9 10 0 4 -3 3 -5 1 -6 -2 -6 -3 -5 -6 -3 -8 0 -9 1 -9 4 -8 6 -6 7 -3 7 -2 6 1 4 3 1 4 0 4 -64 0 0 10 -4 8 0 12 0 4 -64 0 1 10 5 8 1 12 1 4 -64 0 0 -1 -1 -2 -1 -3 0 -4 1 -4 2 -3 2 -2 1 -1 0 -1 -64 0 0 -2 0 -3 1 -3 1 -2 0 -2 -64 -64 2289 79 -16 -9 12 -11 12 -1 10 0 12 0 -9 -64 0 2 10 1 12 1 -9 -64 0 -8 10 -7 12 -7 5 -6 2 -4 0 -1 -1 0 -1 -64 0 -5 10 -6 12 -6 4 -5 1 -64 0 9 10 8 12 8 5 7 2 5 0 2 -1 1 -1 -64 0 6 10 7 12 7 4 6 1 -64 0 -4 -5 5 -5 -64 -64 2290 67 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 5 7 3 6 2 3 1 -5 1 -64 0 3 12 5 11 6 10 7 8 7 5 6 3 5 2 3 1 -64 0 -9 -9 7 -9 7 -4 6 -9 -64 -64 2291 53 -16 -9 12 -10 9 7 11 3 11 -1 10 -4 8 -6 5 -7 2 -7 -1 -6 -4 -4 -7 -1 -9 3 -10 7 -10 -64 0 7 11 4 10 1 8 -1 5 -2 2 -2 -1 -1 -4 1 -7 4 -9 7 -10 -64 -64 2292 59 -16 -9 12 -12 13 -3 1 -5 1 -7 0 -8 -1 -9 -3 -9 -5 -8 -7 -7 -8 -5 -9 -3 -9 -1 -8 0 -7 1 -5 1 -3 0 -1 -1 0 -3 1 -64 0 1 10 -2 1 -64 0 8 8 0 0 -64 0 10 1 1 -2 -64 -64 2293 29 -16 -9 12 -10 10 -3 7 3 -7 -64 0 3 7 -3 -7 -64 0 -7 3 7 -3 -64 0 7 3 -7 -3 -64 -64 2294 101 -16 -9 12 -12 12 -4 -4 -6 -3 -7 -3 -9 -4 -10 -6 -10 -7 -9 -9 -7 -10 -6 -10 -4 -9 -3 -7 -3 -6 -4 -4 -7 0 -8 3 -8 5 -7 8 -5 10 -2 11 2 11 5 10 7 8 8 5 8 3 7 0 4 -4 3 -6 3 -7 4 -9 6 -10 7 -10 9 -9 10 -7 10 -6 9 -4 7 -3 6 -3 4 -4 -64 0 -8 5 -7 7 -5 9 -2 10 2 10 5 9 7 7 8 5 -64 -64 2295 101 -16 -9 12 -12 12 -4 5 -6 4 -7 4 -9 5 -10 7 -10 8 -9 10 -7 11 -6 11 -4 10 -3 8 -3 7 -4 5 -7 1 -8 -2 -8 -4 -7 -7 -5 -9 -2 -10 2 -10 5 -9 7 -7 8 -4 8 -2 7 1 4 5 3 7 3 8 4 10 6 11 7 11 9 10 10 8 10 7 9 5 7 4 6 4 4 5 -64 0 -8 -4 -7 -6 -5 -8 -2 -9 2 -9 5 -8 7 -6 8 -4 -64 -64 2296 31 -16 -9 12 -9 9 -7 -7 7 7 -64 0 -1 6 3 6 7 7 6 3 6 -1 -64 0 3 6 6 6 6 3 -64 -64 2297 31 -16 -9 12 -9 9 7 7 -7 -7 -64 0 -6 1 -6 -3 -7 -7 -3 -6 1 -6 -64 0 -6 -3 -6 -6 -3 -6 -64 -64 2298 31 -16 -9 12 -9 9 7 -7 -7 7 -64 0 1 6 -3 6 -7 7 -6 3 -6 -1 -64 0 -3 6 -6 6 -6 3 -64 -64 2299 31 -16 -9 12 -9 9 -7 7 7 -7 -64 0 -1 -6 3 -6 7 -7 6 -3 6 1 -64 0 3 -6 6 -6 6 -3 -64 -64 2301 85 -16 -9 12 -12 13 -8 5 -9 6 -9 8 -8 10 -6 11 -4 11 -2 10 -1 9 0 7 1 2 -64 0 -9 8 -7 10 -5 10 -3 9 -2 8 -1 6 0 2 0 -9 -64 0 9 5 10 6 10 8 9 10 7 11 5 11 3 10 2 9 1 7 0 2 -64 0 10 8 8 10 6 10 4 9 3 8 2 6 1 2 1 -9 -64 -64 2302 107 -16 -9 12 -12 12 -9 11 -8 7 -7 5 -5 3 -2 2 2 2 5 3 7 5 8 7 9 11 -64 0 -9 11 -8 8 -7 6 -5 4 -2 3 2 3 5 4 7 6 8 8 9 11 -64 0 -2 3 -4 2 -5 1 -6 -1 -6 -4 -5 -6 -3 -8 -1 -9 1 -9 3 -8 5 -6 6 -4 6 -1 5 1 4 2 2 3 -64 0 -2 2 -4 1 -5 -1 -5 -4 -4 -7 -64 0 4 -7 5 -4 5 -1 4 1 2 2 -64 -64 2303 65 -16 -9 12 -12 12 -5 8 -5 -4 -64 0 -4 7 -4 -3 -64 0 4 7 4 -3 -64 0 5 8 5 -4 -64 0 -9 11 -7 9 -5 8 -2 7 2 7 5 8 7 9 9 11 -64 0 -9 -7 -7 -5 -5 -4 -2 -3 2 -3 5 -4 7 -5 9 -7 -64 -64 2304 101 -16 -9 12 -12 12 9 9 -6 9 -8 8 -9 6 -9 4 -8 2 -6 1 -4 1 -2 2 -1 4 -1 6 -2 8 9 8 -64 0 -9 5 -8 3 -7 2 -5 1 -64 0 -1 5 -2 7 -3 8 -5 9 -64 0 -9 -6 6 -6 8 -5 9 -3 9 -1 8 1 6 2 4 2 2 1 1 -1 1 -3 2 -5 -9 -5 -64 0 9 -2 8 0 7 1 5 2 -64 0 1 -2 2 -4 3 -5 5 -6 -64 -64 2305 101 -16 -9 12 -12 11 -3 -3 -5 -2 -6 -2 -8 -3 -9 -5 -9 -6 -8 -8 -6 -9 -5 -9 -3 -8 -2 -6 -2 -5 -3 -3 -8 2 -9 4 -9 7 -8 9 -6 10 -3 11 1 11 5 10 7 8 8 6 8 3 7 0 4 -3 3 -5 3 -7 4 -9 6 -9 7 -8 8 -6 -64 0 -5 -1 -7 2 -8 4 -8 7 -7 9 -6 10 -64 0 1 11 4 10 6 8 7 6 7 3 6 0 4 -3 -64 -64 2306 101 -16 -9 12 -11 13 -10 7 -7 10 -5 7 -5 -4 -64 0 -8 9 -6 6 -6 -4 -64 0 -5 7 -2 10 0 7 0 -3 -64 0 -3 9 -1 6 -1 -3 -64 0 0 7 3 10 5 7 5 -9 -64 0 2 9 4 6 4 -9 -64 0 5 7 8 10 9 8 10 5 10 2 9 -1 8 -3 6 -5 3 -7 -2 -9 -64 0 7 9 8 8 9 5 9 2 8 -1 7 -3 5 -5 2 -7 -2 -9 -64 -64 2307 87 -16 -9 12 -12 12 -9 -1 -5 -1 -6 0 -7 3 -7 5 -6 8 -4 10 -1 11 1 11 4 10 6 8 7 5 7 3 6 0 5 -1 9 -1 -64 0 -9 -2 -3 -2 -5 0 -6 3 -6 5 -5 8 -3 10 -1 11 -64 0 1 11 3 10 5 8 6 5 6 3 5 0 3 -2 9 -2 -64 0 -7 -6 7 -6 -64 0 -7 -7 7 -7 -64 -64 2308 65 -16 -9 12 -12 13 -11 6 -8 9 -5 6 -5 -6 -64 0 -9 8 -6 5 -6 -6 -64 0 -5 6 -2 9 1 6 1 -6 -64 0 -3 8 0 5 0 -6 -64 0 1 6 4 9 7 6 7 -5 9 -7 -64 0 3 8 6 5 6 -6 8 -8 11 -5 -64 -64 2309 71 -16 -9 12 -11 11 8 9 -8 -7 -64 0 8 9 5 8 -1 8 -64 0 6 7 3 7 -1 8 -64 0 8 9 7 6 7 0 -64 0 6 7 6 4 7 0 -64 0 -1 0 -8 0 -64 0 -2 -1 -5 -1 -8 0 -64 0 -1 0 -1 -7 -64 0 -2 -1 -2 -4 -1 -7 -64 -64 2310 71 -16 -9 12 -12 12 -10 3 -8 7 -3 -3 -64 0 -8 5 -3 -5 0 2 5 2 8 3 9 5 9 7 8 9 6 10 5 10 3 9 2 7 2 5 3 2 4 0 5 -3 5 -6 3 -8 -64 0 5 10 4 9 3 7 3 5 5 1 6 -2 6 -5 5 -7 3 -8 -64 -64 2311 77 -16 -9 12 -12 12 -9 3 -6 6 -2 4 -64 0 -7 5 -3 3 0 6 3 4 -64 0 -1 5 2 3 5 6 7 4 -64 0 4 5 6 3 9 6 -64 0 -9 -3 -6 0 -2 -2 -64 0 -7 -1 -3 -3 0 0 3 -2 -64 0 -1 -1 2 -3 5 0 7 -2 -64 0 4 -1 6 -3 9 0 -64 -64 2312 101 -16 -9 12 -12 12 -8 10 -4 8 -2 6 -1 3 -1 0 -2 -3 -4 -5 -8 -7 -64 0 -8 10 -5 9 -3 8 -1 6 0 3 -64 0 0 0 -1 -3 -3 -5 -5 -6 -8 -7 -64 0 8 10 5 9 3 8 1 6 0 3 -64 0 0 0 1 -3 3 -5 5 -6 8 -7 -64 0 8 10 4 8 2 6 1 3 1 0 2 -3 4 -5 8 -7 -64 0 -9 2 9 2 -64 0 -9 1 9 1 -64 -64 2317 29 -16 -9 12 -4 4 -1 1 -1 -1 1 -1 1 1 -1 1 -64 0 -1 1 1 -1 -64 0 1 1 -1 -1 -64 -64 2318 41 -16 -9 12 -8 8 -5 2 -1 0 2 -2 4 -4 5 -7 5 -9 4 -11 3 -12 -64 0 -5 1 1 -2 -64 0 -5 0 -2 -1 2 -3 4 -5 5 -7 -64 -64 2319 41 -16 -9 12 -8 8 5 7 4 5 2 3 -2 1 -5 0 -64 0 1 2 -5 -1 -64 0 3 12 4 11 5 9 5 7 4 4 2 2 -1 0 -5 -2 -64 -64 2320 77 -16 -9 12 -10 10 1 5 -3 4 -6 2 -7 0 -7 -2 -6 -4 -4 -5 -1 -5 3 -4 6 -2 7 0 7 2 6 4 4 5 1 5 -64 0 6 4 1 5 -64 0 4 5 -1 4 -6 2 -64 0 -3 4 -7 0 -64 0 -6 -4 -1 -5 -64 0 -4 -5 1 -4 6 -2 -64 0 3 -4 7 0 -64 -64 2321 77 -16 -9 12 -10 10 1 5 -3 4 -6 2 -7 0 -7 -2 -6 -4 -4 -5 -1 -5 3 -4 6 -2 7 0 7 2 6 4 4 5 1 5 -64 0 6 4 1 5 -64 0 4 5 -1 4 -6 2 -64 0 -3 4 -7 0 -64 0 -6 -4 -1 -5 -64 0 -4 -5 1 -4 6 -2 -64 0 3 -4 7 0 -64 -64 2322 73 -16 -9 12 -8 9 1 5 -2 4 -4 2 -5 0 -5 -2 -4 -4 -2 -5 0 -5 3 -4 5 -2 6 0 6 2 5 4 3 5 1 5 -64 0 -3 2 3 5 -64 0 -4 0 4 4 -64 0 -5 -2 5 3 -64 0 -4 -3 6 2 -64 0 -3 -4 5 0 -64 0 -2 -5 4 -2 -64 -64 2323 41 -16 -9 12 -8 8 -3 11 -3 -12 -64 0 3 12 3 -11 -64 0 -5 4 5 6 -64 0 -5 3 5 5 -64 0 -5 -5 5 -3 -64 0 -5 -6 5 -4 -64 -64 2324 41 -16 -9 12 -8 8 -4 12 -4 -6 -64 0 4 6 4 -12 -64 0 -4 4 4 6 -64 0 -4 3 4 5 -64 0 -4 -5 4 -3 -64 0 -4 -6 4 -4 -64 -64 2325 55 -16 -9 12 -8 8 -4 16 -4 -5 -64 0 -4 4 -1 6 2 6 4 5 5 3 5 1 4 -1 1 -3 -1 -4 -4 -5 -64 0 -4 4 -1 5 2 5 4 4 -64 0 3 5 4 3 4 1 3 -1 1 -3 -64 -64 2326 41 -16 -9 12 -13 13 -10 9 -10 6 -64 0 10 9 10 6 -64 0 -10 9 10 9 -64 0 -10 8 10 8 -64 0 -10 7 10 7 -64 0 -10 6 10 6 -64 -64 2327 41 -16 -9 12 -8 8 -5 4 -5 1 -64 0 5 4 5 1 -64 0 -5 4 5 4 -64 0 -5 3 5 3 -64 0 -5 2 5 2 -64 0 -5 1 5 1 -64 -64 2328 103 -16 -9 12 -8 8 -5 6 5 -6 -64 0 -5 6 -3 4 -1 3 2 3 4 4 5 5 5 7 3 7 3 5 2 3 -64 0 -3 4 2 3 -64 0 -1 3 5 5 -64 0 4 7 4 4 -64 0 3 6 5 6 -64 0 5 -6 3 -4 1 -3 -2 -3 -4 -4 -5 -5 -5 -7 -3 -7 -3 -5 -2 -3 -64 0 3 -4 -2 -3 -64 0 1 -3 -5 -5 -64 0 -4 -4 -4 -7 -64 0 -5 -6 -3 -6 -64 -64 2329 57 -16 -9 12 -8 8 -2 3 -3 5 -3 7 -5 7 -5 5 -4 4 -2 3 1 3 3 4 5 6 -64 0 -4 7 -4 4 -64 0 -5 6 -3 6 -64 0 -5 5 1 3 -64 0 -2 3 3 4 -64 0 5 6 5 -7 -64 -64 2330 177 -16 -9 12 -17 12 -11 -20 -10 -20 -9 -19 -9 -18 -10 -17 -11 -17 -12 -18 -12 -20 -11 -22 -9 -23 -7 -23 -4 -22 -2 -20 -1 -18 0 -14 0 -3 -1 23 -1 30 0 35 1 37 3 38 4 38 6 37 7 35 7 31 6 28 5 26 3 23 -2 19 -8 15 -10 13 -12 10 -13 8 -14 4 -14 0 -13 -4 -11 -7 -8 -9 -4 -10 0 -10 4 -9 6 -8 8 -5 9 -2 9 2 8 5 7 7 5 9 2 10 -2 10 -5 9 -7 7 -8 4 -8 0 -7 -3 -5 -5 -64 0 -11 -18 -11 -19 -10 -19 -10 -18 -11 -18 -64 0 3 23 -1 19 -6 15 -9 12 -11 9 -12 7 -13 4 -13 0 -12 -4 -11 -6 -8 -9 -64 0 0 -10 3 -9 5 -8 7 -5 8 -2 8 2 7 5 6 7 4 9 2 10 -64 -64 2331 211 -16 -9 12 -13 20 -4 -1 -3 -3 -1 -4 1 -4 3 -3 4 -1 4 1 3 3 1 4 -1 4 -3 3 -4 2 -5 -1 -5 -4 -4 -7 -2 -9 1 -10 4 -10 7 -9 9 -7 10 -5 11 -2 11 2 10 5 8 8 6 9 3 10 0 10 -3 9 -5 8 -7 6 -9 3 -10 -1 -10 -6 -9 -11 -7 -15 -5 -17 -2 -19 2 -20 7 -20 11 -19 14 -17 16 -15 -64 0 -7 6 -8 4 -9 0 -9 -6 -8 -10 -6 -14 -4 -16 -1 -18 3 -19 7 -19 11 -18 13 -17 16 -15 -64 0 -2 3 2 3 -64 0 -3 2 3 2 -64 0 -4 1 4 1 -64 0 -4 0 4 0 -64 0 -4 -1 4 -1 -64 0 -3 -2 3 -2 -64 0 -2 -3 2 -3 -64 0 15 6 15 4 17 4 17 6 15 6 -64 0 16 6 16 4 -64 0 15 5 17 5 -64 0 15 -4 15 -6 17 -6 17 -4 15 -4 -64 0 16 -4 16 -6 -64 0 15 -5 17 -5 -64 -64 2332 65 -16 -9 12 -14 14 -10 18 -10 -18 -64 0 -5 18 -5 -18 -64 0 5 18 5 -18 -64 0 10 18 10 -18 -64 0 -5 5 5 7 -64 0 -5 4 5 6 -64 0 -5 3 5 5 -64 0 -5 -5 5 -3 -64 0 -5 -6 5 -4 -64 0 -5 -7 5 -5 -64 -64 2367 29 -16 -9 12 -4 4 -1 1 -1 -1 1 -1 1 1 -1 1 -64 0 -1 1 1 -1 -64 0 1 1 -1 -1 -64 -64 2368 41 -16 -9 12 -8 8 -5 2 -1 0 2 -2 4 -4 5 -7 5 -9 4 -11 3 -12 -64 0 -5 1 1 -2 -64 0 -5 0 -2 -1 2 -3 4 -5 5 -7 -64 -64 2369 41 -16 -9 12 -8 8 5 7 4 5 2 3 -2 1 -5 0 -64 0 1 2 -5 -1 -64 0 3 12 4 11 5 9 5 7 4 4 2 2 -1 0 -5 -2 -64 -64 2370 69 -16 -9 12 -10 10 -2 5 -5 4 -6 3 -7 1 -7 -1 -6 -3 -5 -4 -2 -5 2 -5 5 -4 6 -3 7 -1 7 1 6 3 5 4 2 5 -2 5 -64 0 -5 4 -6 2 -6 -1 -5 -3 -4 -4 -2 -5 -64 0 5 -4 6 -2 6 1 5 3 4 4 2 5 -64 -64 2371 77 -16 -9 12 -10 10 1 5 -3 4 -6 2 -7 0 -7 -2 -6 -4 -4 -5 -1 -5 3 -4 6 -2 7 0 7 2 6 4 4 5 1 5 -64 0 6 4 1 5 -64 0 4 5 -1 4 -6 2 -64 0 -3 4 -7 0 -64 0 -6 -4 -1 -5 -64 0 -4 -5 1 -4 6 -2 -64 0 3 -4 7 0 -64 -64 2372 73 -16 -9 12 -8 9 1 5 -2 4 -4 2 -5 0 -5 -2 -4 -4 -2 -5 0 -5 3 -4 5 -2 6 0 6 2 5 4 3 5 1 5 -64 0 -3 2 3 5 -64 0 -4 0 4 4 -64 0 -5 -2 5 3 -64 0 -4 -3 6 2 -64 0 -3 -4 5 0 -64 0 -2 -5 4 -2 -64 -64 2373 41 -16 -9 12 -8 8 -3 11 -3 -12 -64 0 3 12 3 -11 -64 0 -5 4 5 6 -64 0 -5 3 5 5 -64 0 -5 -5 5 -3 -64 0 -5 -6 5 -4 -64 -64 2374 41 -16 -9 12 -8 8 -4 12 -4 -6 -64 0 4 6 4 -12 -64 0 -4 4 4 6 -64 0 -4 3 4 5 -64 0 -4 -5 4 -3 -64 0 -4 -6 4 -4 -64 -64 2375 55 -16 -9 12 -8 8 -4 16 -4 -5 -64 0 -4 4 -1 6 2 6 4 5 5 3 5 1 4 -1 1 -3 -1 -4 -4 -5 -64 0 -4 4 -1 5 2 5 4 4 -64 0 3 5 4 3 4 1 3 -1 1 -3 -64 -64 2376 41 -16 -9 12 -13 13 -10 9 -10 6 -64 0 10 9 10 6 -64 0 -10 9 10 9 -64 0 -10 8 10 8 -64 0 -10 7 10 7 -64 0 -10 6 10 6 -64 -64 2377 41 -16 -9 12 -8 8 -5 4 -5 1 -64 0 5 4 5 1 -64 0 -5 4 5 4 -64 0 -5 3 5 3 -64 0 -5 2 5 2 -64 0 -5 1 5 1 -64 -64 2378 77 -16 -9 12 -8 8 -1 15 4 5 0 -2 0 -3 -64 0 3 6 -1 -1 -64 0 2 9 2 7 -2 0 0 -3 3 -7 -64 0 5 -10 3 -7 1 -6 -1 -6 -3 -7 -4 -9 -4 -11 -3 -13 0 -15 -64 0 5 -10 3 -8 1 -7 -3 -7 -3 -11 -2 -13 0 -15 -64 0 1 -6 -2 -8 -4 -11 -64 -64 2379 57 -16 -9 12 -8 8 -2 3 -3 5 -3 7 -5 7 -5 5 -4 4 -2 3 1 3 3 4 5 6 -64 0 -4 7 -4 4 -64 0 -5 6 -3 6 -64 0 -5 5 1 3 -64 0 -2 3 3 4 -64 0 5 6 1 -7 -64 -64 2380 177 -16 -9 12 -17 12 -11 -20 -10 -20 -9 -19 -9 -18 -10 -17 -11 -17 -12 -18 -12 -20 -11 -22 -9 -23 -7 -23 -4 -22 -2 -20 -1 -18 0 -14 0 -3 -1 23 -1 30 0 35 1 37 3 38 4 38 6 37 7 35 7 31 6 28 5 26 3 23 -2 19 -8 15 -10 13 -12 10 -13 8 -14 4 -14 0 -13 -4 -11 -7 -8 -9 -4 -10 0 -10 4 -9 6 -8 8 -5 9 -2 9 2 8 5 7 7 5 9 2 10 -2 10 -5 9 -7 7 -8 4 -8 0 -7 -3 -5 -5 -64 0 -11 -18 -11 -19 -10 -19 -10 -18 -11 -18 -64 0 3 23 -1 19 -6 15 -9 12 -11 9 -12 7 -13 4 -13 0 -12 -4 -11 -6 -8 -9 -64 0 0 -10 3 -9 5 -8 7 -5 8 -2 8 2 7 5 6 7 4 9 2 10 -64 -64 2381 183 -16 -9 12 -9 24 -4 1 -3 3 -1 4 1 4 3 3 4 1 4 -1 3 -3 1 -4 -1 -4 -3 -3 -4 -2 -5 1 -5 4 -4 7 -2 9 1 10 5 10 9 9 12 7 14 4 15 0 15 -5 14 -9 13 -11 11 -14 8 -17 4 -20 -1 -23 -5 -25 -64 0 5 10 8 9 11 7 13 4 14 0 14 -5 13 -9 12 -11 10 -14 7 -17 2 -21 -1 -23 -64 0 -2 3 2 3 -64 0 -3 2 3 2 -64 0 -4 1 4 1 -64 0 -4 0 4 0 -64 0 -4 -1 4 -1 -64 0 -3 -2 3 -2 -64 0 -2 -3 2 -3 -64 0 19 6 19 4 21 4 21 6 19 6 -64 0 20 6 20 4 -64 0 19 5 21 5 -64 0 19 -4 19 -6 21 -6 21 -4 19 -4 -64 0 20 -4 20 -6 -64 0 19 -5 21 -5 -64 -64 2382 175 -16 -9 12 -14 14 -10 20 -10 -20 -64 0 -9 20 -9 -20 -64 0 -5 20 -5 -20 -64 0 -1 16 1 16 1 14 -1 14 -1 17 0 19 2 20 5 20 7 19 9 17 10 14 10 9 9 6 7 4 5 3 3 3 1 4 0 6 -1 4 -3 1 -4 0 -3 -1 -1 -4 0 -6 1 -4 3 -3 5 -3 7 -4 9 -6 10 -9 10 -14 9 -17 7 -19 5 -20 2 -20 0 -19 -1 -17 -1 -14 1 -14 1 -16 -1 -16 -64 0 0 16 0 14 -64 0 -1 15 1 15 -64 0 7 19 8 17 9 14 9 9 8 6 7 4 -64 0 0 6 0 4 -2 1 -4 0 -2 -1 0 -4 0 -6 -64 0 7 -4 8 -6 9 -9 9 -14 8 -17 7 -19 -64 0 0 -14 0 -16 -64 0 -1 -15 1 -15 -64 -64 2401 47 -16 -9 12 -17 17 -10 16 -10 -16 -64 0 -9 16 -9 -16 -64 0 9 16 9 -16 -64 0 10 16 10 -16 -64 0 -14 16 14 16 -64 0 -14 -16 -5 -16 -64 0 5 -16 14 -16 -64 -64 2402 51 -16 -9 12 -16 15 -11 16 -1 2 -12 -16 -64 0 -12 16 -2 2 -64 0 -13 16 -2 1 -64 0 -13 16 10 16 12 9 9 16 -64 0 -11 -15 10 -15 -64 0 -12 -16 10 -16 12 -9 9 -16 -64 -64 2403 61 -16 -9 12 -9 9 6 39 3 33 0 26 -2 21 -3 17 -4 12 -5 4 -5 -4 -4 -12 -3 -17 -2 -21 0 -26 3 -33 6 -39 -64 0 3 33 1 28 -1 22 -2 18 -3 12 -4 4 -4 -4 -3 -12 -2 -18 -1 -22 1 -28 3 -33 -64 -64 2404 61 -16 -9 12 -9 9 -6 39 -3 33 0 26 2 21 3 17 4 12 5 4 5 -4 4 -12 3 -17 2 -21 0 -26 -3 -33 -6 -39 -64 0 -3 33 -1 28 1 22 2 18 3 12 4 4 4 -4 3 -12 2 -18 1 -22 -1 -28 -3 -33 -64 -64 2405 33 -16 -9 12 -9 9 -5 39 -5 0 -5 -39 -64 0 -4 39 -4 0 -4 -39 -64 0 -5 39 6 39 -64 0 -5 -39 6 -39 -64 -64 2406 33 -16 -9 12 -9 9 4 39 4 0 4 -39 -64 0 5 39 5 0 5 -39 -64 0 -6 39 5 39 -64 0 -6 -39 5 -39 -64 -64 2407 81 -16 -9 12 -10 9 4 39 0 33 -2 29 -3 24 -3 20 -2 16 2 8 2 6 1 4 0 3 -5 0 0 -3 1 -4 2 -6 2 -8 -2 -16 -3 -20 -3 -24 -2 -29 0 -33 4 -39 -64 0 2 36 0 32 -1 29 -2 24 -2 20 -1 15 0 12 -64 0 0 -12 -1 -15 -2 -20 -2 -24 -1 -29 0 -32 2 -36 -64 -64 2408 81 -16 -9 12 -9 10 -4 39 0 33 2 29 3 24 3 20 2 16 -2 8 -2 6 -1 4 0 3 5 0 0 -3 -1 -4 -2 -6 -2 -8 2 -16 3 -20 3 -24 2 -29 0 -33 -4 -39 -64 0 -2 36 0 32 1 29 2 24 2 20 1 15 0 12 -64 0 0 -12 1 -15 2 -20 2 -24 1 -29 0 -32 -2 -36 -64 -64 2409 69 -16 -9 12 -9 9 4 36 1 33 -1 30 -3 26 -4 21 -4 15 -3 9 -2 5 1 -6 2 -10 3 -16 3 -21 2 -26 1 -29 -1 -33 -64 0 1 33 -1 29 -2 26 -3 21 -3 16 -2 10 -1 6 2 -5 3 -9 4 -15 4 -21 3 -26 1 -30 -1 -33 -4 -36 -64 -64 2410 69 -16 -9 12 -9 9 -4 36 -1 33 1 30 3 26 4 21 4 15 3 9 2 5 -1 -6 -2 -10 -3 -16 -3 -21 -2 -26 -1 -29 1 -33 -64 0 -1 33 1 29 2 26 3 21 3 16 2 10 1 6 -2 -5 -3 -9 -4 -15 -4 -21 -3 -26 -1 -30 1 -33 4 -36 -64 -64 2411 33 -16 -9 12 -27 8 -24 0 -17 0 0 -29 -64 0 -18 0 -1 -29 -64 0 -19 0 0 -32 -64 0 8 48 4 8 0 -32 -64 -64 2412 119 -16 -9 12 -15 15 11 36 10 36 9 35 9 34 10 33 11 33 12 34 12 36 11 38 9 39 7 39 5 38 3 36 2 34 1 31 0 24 -1 8 -1 -24 -2 -33 -3 -36 -64 0 10 35 10 34 11 34 11 35 10 35 -64 0 0 24 0 -24 -64 0 3 36 2 33 1 24 1 -8 0 -24 -1 -31 -2 -34 -3 -36 -5 -38 -7 -39 -9 -39 -11 -38 -12 -36 -12 -34 -11 -33 -10 -33 -9 -34 -9 -35 -10 -36 -11 -36 -64 0 -11 -34 -11 -35 -10 -35 -10 -34 -11 -34 -64 -64 2501 45 -16 -9 12 -10 10 0 12 -8 -9 -64 0 0 9 -7 -9 -8 -9 -64 0 0 9 7 -9 8 -9 -64 0 0 12 8 -9 -64 0 -5 -3 5 -3 -64 0 -6 -4 6 -4 -64 -64 2502 93 -16 -9 12 -10 10 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -6 12 2 12 5 11 6 10 7 8 7 5 6 3 5 2 2 1 -64 0 -5 11 2 11 5 10 6 8 6 5 5 3 2 2 -64 0 -5 2 2 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -6 -9 -64 0 -5 1 2 1 5 0 6 -2 6 -5 5 -7 2 -8 -5 -8 -64 -64 2503 81 -16 -9 12 -10 11 8 7 7 9 5 11 3 12 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 3 -9 5 -8 7 -6 8 -4 -64 0 8 7 7 7 6 9 5 10 3 11 -1 11 -3 10 -5 7 -6 4 -6 -1 -5 -4 -3 -7 -1 -8 3 -8 5 -7 6 -6 7 -4 8 -4 -64 -64 2504 69 -16 -9 12 -10 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -6 12 1 12 4 11 6 9 7 7 8 4 8 -1 7 -4 6 -6 4 -8 1 -9 -6 -9 -64 0 -5 11 1 11 4 10 5 9 6 7 7 4 7 -1 6 -4 5 -6 4 -7 1 -8 -5 -8 -64 -64 2505 59 -16 -9 12 -9 10 -5 12 -5 -9 -64 0 -4 11 -4 -8 -64 0 -5 12 7 12 -64 0 -4 11 7 11 7 12 -64 0 -4 2 2 2 2 1 -64 0 -4 1 2 1 -64 0 -4 -8 7 -8 7 -9 -64 0 -5 -9 7 -9 -64 -64 2506 47 -16 -9 12 -9 9 -5 12 -5 -9 -64 0 -4 11 -4 -9 -5 -9 -64 0 -5 12 7 12 -64 0 -4 11 7 11 7 12 -64 0 -4 2 2 2 2 1 -64 0 -4 1 2 1 -64 -64 2507 93 -16 -9 12 -10 11 8 7 7 9 5 11 3 12 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 3 -9 5 -8 7 -6 8 -4 8 0 3 0 -64 0 8 7 7 7 6 9 5 10 3 11 -1 11 -3 10 -4 9 -5 7 -6 4 -6 -1 -5 -4 -4 -6 -3 -7 -1 -8 3 -8 5 -7 6 -6 7 -4 7 -1 3 -1 3 0 -64 -64 2508 49 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 -7 12 -6 12 -6 -9 -7 -9 -64 0 7 12 6 12 6 -9 7 -9 -64 0 7 12 7 -9 -64 0 -6 2 6 2 -64 0 -6 1 6 1 -64 -64 2509 21 -16 -9 12 -4 5 0 12 0 -9 1 -9 -64 0 0 12 1 12 1 -9 -64 -64 2510 45 -16 -9 12 -8 9 4 12 4 -4 3 -7 1 -8 -1 -8 -3 -7 -4 -4 -5 -4 -64 0 4 12 5 12 5 -4 4 -7 3 -8 1 -9 -1 -9 -3 -8 -4 -7 -5 -4 -64 -64 2511 49 -16 -9 12 -10 11 -6 12 -6 -9 -5 -9 -64 0 -6 12 -5 12 -5 -9 -64 0 8 12 7 12 -5 0 -64 0 8 12 -5 -1 -64 0 -2 3 7 -9 8 -9 -64 0 -1 3 8 -9 -64 -64 2512 33 -16 -9 12 -9 8 -5 12 -5 -9 -64 0 -5 12 -4 12 -4 -8 -64 0 -4 -8 7 -8 7 -9 -64 0 -5 -9 7 -9 -64 -64 2513 57 -16 -9 12 -12 12 -8 12 -8 -9 -64 0 -7 7 -7 -9 -8 -9 -64 0 -7 7 0 -9 -64 0 -8 12 0 -6 -64 0 8 12 0 -6 -64 0 7 7 0 -9 -64 0 7 7 7 -9 8 -9 -64 0 8 12 8 -9 -64 -64 2514 45 -16 -9 12 -11 11 -7 12 -7 -9 -64 0 -6 9 -6 -9 -7 -9 -64 0 -6 9 7 -9 -64 0 -7 12 6 -6 -64 0 6 12 6 -6 -64 0 6 12 7 12 7 -9 -64 -64 2515 85 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 0 -1 11 -4 10 -6 7 -7 4 -7 -1 -6 -4 -4 -7 -1 -8 1 -8 4 -7 6 -4 7 -1 7 4 6 7 4 10 1 11 -1 11 -64 -64 2516 59 -16 -9 12 -10 10 -6 12 -6 -9 -64 0 -5 11 -5 -9 -6 -9 -64 0 -6 12 3 12 5 11 6 10 7 8 7 5 6 3 5 2 3 1 -5 1 -64 0 -5 11 3 11 5 10 6 8 6 5 5 3 3 2 -5 2 -64 -64 2517 101 -16 -9 12 -11 11 -2 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -2 -9 2 -9 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 2 12 -2 12 -64 0 -1 11 -4 10 -6 7 -7 4 -7 -1 -6 -4 -4 -7 -1 -8 1 -8 4 -7 6 -4 7 -1 7 4 6 7 4 10 1 11 -1 11 -64 0 1 -6 6 -11 7 -11 -64 0 1 -6 2 -6 7 -11 -64 -64 2518 73 -16 -9 12 -10 10 -6 12 -6 -9 -64 0 -5 11 -5 -9 -6 -9 -64 0 -6 12 2 12 5 11 6 10 7 8 7 5 6 3 5 2 2 1 -5 1 -64 0 -5 11 2 11 5 10 6 8 6 5 5 3 2 2 -5 2 -64 0 0 1 6 -9 7 -9 -64 0 1 1 7 -9 -64 -64 2519 91 -16 -9 12 -10 10 7 9 5 11 2 12 -2 12 -5 11 -7 9 -7 7 -6 5 -5 4 -3 3 2 1 4 0 5 -1 6 -3 6 -6 5 -7 2 -8 -2 -8 -4 -7 -5 -6 -7 -6 -64 0 7 9 5 9 4 10 2 11 -2 11 -5 10 -6 9 -6 7 -5 5 -3 4 2 2 4 1 6 -1 7 -3 7 -6 5 -8 2 -9 -2 -9 -5 -8 -7 -6 -64 -64 2520 35 -16 -9 12 -8 9 0 11 0 -9 -64 0 1 11 1 -9 0 -9 -64 0 -6 12 7 12 7 11 -64 0 -6 12 -6 11 7 11 -64 -64 2521 53 -16 -9 12 -11 11 -7 12 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 12 -64 0 -7 12 -6 12 -6 -3 -5 -6 -4 -7 -1 -8 1 -8 4 -7 5 -6 6 -3 6 12 7 12 -64 -64 2522 33 -16 -9 12 -10 10 -8 12 0 -9 -64 0 -8 12 -7 12 0 -6 -64 0 8 12 7 12 0 -6 -64 0 8 12 0 -9 -64 -64 2523 57 -16 -9 12 -13 13 -11 12 -5 -9 -64 0 -11 12 -10 12 -5 -6 -64 0 0 12 -5 -6 -64 0 0 9 -5 -9 -64 0 0 9 5 -9 -64 0 0 12 5 -6 -64 0 11 12 10 12 5 -6 -64 0 11 12 5 -9 -64 -64 2524 37 -16 -9 12 -10 10 -7 12 6 -9 7 -9 -64 0 -7 12 -6 12 7 -9 -64 0 7 12 6 12 -7 -9 -64 0 7 12 -6 -9 -7 -9 -64 -64 2525 39 -16 -9 12 -9 10 -7 12 0 2 0 -9 1 -9 -64 0 -7 12 -6 12 1 2 -64 0 8 12 7 12 0 2 -64 0 8 12 1 2 1 -9 -64 -64 2526 45 -16 -9 12 -10 10 6 12 -7 -9 -64 0 7 12 -6 -9 -64 0 -7 12 7 12 -64 0 -7 12 -7 11 6 11 -64 0 -6 -8 7 -8 7 -9 -64 0 -7 -9 7 -9 -64 -64 2551 81 -16 -9 12 -13 10 6 12 4 10 2 7 -1 2 -3 -1 -6 -5 -9 -8 -11 -9 -13 -9 -14 -8 -14 -6 -13 -5 -12 -6 -13 -7 -64 0 6 12 5 8 3 -2 2 -9 -64 0 6 12 3 -9 -64 0 2 -9 2 -7 1 -4 0 -2 -2 0 -4 1 -6 1 -7 0 -7 -2 -6 -5 -3 -8 0 -9 4 -9 6 -8 -64 -64 2552 145 -16 -9 12 -12 12 3 11 2 10 1 8 -1 3 -3 -3 -4 -5 -6 -8 -8 -9 -64 0 2 10 1 7 -1 -1 -2 -4 -3 -6 -5 -8 -8 -9 -10 -9 -11 -8 -11 -6 -10 -5 -9 -6 -10 -7 -64 0 -3 6 -4 4 -5 3 -7 3 -8 4 -8 6 -7 8 -5 10 -3 11 0 12 6 12 8 11 9 9 9 7 8 5 6 4 2 3 0 3 -64 0 6 12 7 11 8 9 8 7 7 5 6 4 -64 0 2 3 5 2 6 1 7 -1 7 -4 6 -7 5 -8 3 -9 1 -9 0 -8 0 -6 1 -3 -64 0 2 3 4 2 5 1 6 -1 6 -4 5 -7 3 -9 -64 -64 2553 87 -16 -9 12 -10 11 -7 10 -8 8 -8 6 -7 4 -4 3 -1 3 3 4 5 5 7 7 8 9 8 11 7 12 5 12 2 11 -1 8 -3 5 -5 1 -6 -3 -6 -6 -5 -8 -2 -9 0 -9 3 -8 5 -6 6 -4 6 -2 5 0 3 0 1 -1 0 -3 -64 0 5 12 3 11 0 8 -2 5 -4 1 -5 -3 -5 -6 -4 -8 -2 -9 -64 -64 2554 91 -16 -9 12 -12 11 3 11 2 10 1 8 -1 3 -3 -3 -4 -5 -6 -8 -8 -9 -64 0 2 10 1 7 -1 -1 -2 -4 -3 -6 -5 -8 -8 -9 -10 -9 -11 -8 -11 -6 -10 -5 -8 -5 -6 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 7 -2 8 3 8 6 7 9 5 11 3 12 -2 12 -5 11 -7 9 -8 7 -8 5 -7 4 -5 4 -4 5 -3 7 -64 -64 2555 103 -16 -9 12 -9 10 5 9 4 8 4 6 5 5 7 5 8 7 8 9 7 11 5 12 2 12 0 11 -1 10 -2 8 -2 6 -1 4 1 3 -64 0 2 12 0 10 -1 8 -1 5 1 3 -64 0 1 3 -1 3 -4 2 -6 0 -7 -2 -7 -5 -6 -7 -5 -8 -3 -9 0 -9 3 -8 5 -6 6 -4 6 -2 5 0 3 0 1 -1 0 -3 -64 0 -1 3 -3 2 -5 0 -6 -2 -6 -6 -5 -8 -64 -64 2556 97 -16 -9 12 -11 10 5 10 4 8 2 3 0 -3 -1 -5 -3 -8 -5 -9 -64 0 -1 6 -2 4 -4 3 -6 3 -7 5 -7 7 -6 9 -4 11 -1 12 9 12 6 11 5 10 4 7 2 -1 1 -4 0 -6 -2 -8 -5 -9 -7 -9 -9 -8 -10 -7 -10 -6 -9 -5 -8 -6 -9 -7 -64 0 1 12 5 11 6 11 -64 0 -3 -1 -2 0 0 1 4 1 6 2 8 5 6 -2 -64 -64 2557 111 -16 -9 12 -11 11 -8 9 -9 7 -9 5 -8 3 -6 2 -3 2 0 3 2 4 5 7 6 10 6 11 5 12 4 12 2 11 0 9 -1 7 -2 4 -2 1 -1 -1 1 -2 3 -2 5 -1 7 1 8 3 -64 0 5 12 3 11 1 9 0 7 -1 4 -1 0 1 -2 -64 0 8 3 7 -1 5 -5 3 -7 1 -8 -3 -9 -6 -9 -8 -8 -9 -6 -9 -5 -8 -4 -7 -5 -8 -6 -64 0 7 -1 5 -4 3 -6 0 -8 -3 -9 -64 -64 2558 115 -16 -9 12 -12 12 -6 6 -7 7 -7 9 -6 11 -3 12 0 12 -3 1 -5 -5 -6 -7 -7 -8 -9 -9 -11 -9 -12 -8 -12 -6 -11 -5 -10 -6 -11 -7 -64 0 0 12 -3 3 -4 0 -6 -5 -7 -7 -9 -9 -64 0 -8 -2 -7 -1 -5 0 4 3 6 4 9 6 11 8 12 10 12 11 11 12 10 12 8 11 6 8 5 6 3 0 2 -4 2 -7 4 -9 5 -9 7 -8 9 -6 -64 0 10 12 8 10 6 6 4 0 3 -4 3 -7 4 -9 -64 -64 2559 71 -16 -9 12 -9 7 5 10 3 7 1 2 -1 -3 -2 -5 -4 -8 -6 -9 -64 0 7 6 5 4 2 3 -1 3 -3 4 -4 6 -4 8 -3 10 -1 11 3 12 7 12 5 10 4 8 2 2 0 -4 -1 -6 -3 -8 -6 -9 -8 -9 -9 -8 -9 -6 -8 -5 -7 -6 -8 -7 -64 -64 2560 73 -16 -9 12 -9 8 7 12 5 10 3 7 1 2 -2 -7 -4 -11 -64 0 7 5 5 3 2 2 -1 2 -3 3 -4 5 -4 7 -3 9 -1 11 3 12 7 12 5 9 4 7 1 -2 -1 -6 -2 -8 -4 -11 -5 -12 -7 -13 -8 -12 -8 -10 -7 -8 -5 -6 -3 -5 0 -4 4 -3 -64 -64 2561 123 -16 -9 12 -12 12 -6 6 -7 7 -7 9 -5 11 -2 12 0 12 -3 1 -5 -5 -6 -7 -7 -8 -9 -9 -11 -9 -12 -8 -12 -6 -11 -5 -10 -6 -11 -7 -64 0 0 12 -3 3 -4 0 -6 -5 -7 -7 -9 -9 -64 0 8 11 5 7 3 5 1 4 -2 3 -64 0 11 11 10 10 11 9 12 10 12 11 11 12 10 12 8 11 5 6 4 5 2 4 -2 3 -64 0 -2 3 1 2 2 0 3 -7 4 -9 -64 0 -2 3 0 2 1 0 2 -7 4 -9 5 -9 7 -8 9 -6 -64 -64 2562 85 -16 -9 12 -9 9 -5 9 -6 7 -6 5 -5 3 -3 2 0 2 3 3 5 4 8 7 9 10 9 11 8 12 7 12 5 11 4 10 2 7 -2 -3 -3 -5 -5 -8 -7 -9 -64 0 4 10 2 6 0 -1 -1 -4 -2 -6 -4 -8 -7 -9 -9 -9 -10 -8 -10 -6 -9 -5 -7 -5 -5 -6 -2 -8 0 -9 3 -9 5 -8 7 -6 -64 -64 2563 103 -16 -9 12 -14 14 0 12 -4 3 -7 -3 -9 -6 -11 -8 -13 -9 -15 -9 -16 -8 -16 -6 -15 -5 -14 -6 -15 -7 -64 0 0 12 -2 5 -3 1 -4 -4 -4 -8 -2 -9 -64 0 0 12 -1 8 -2 3 -3 -4 -3 -8 -2 -9 -64 0 9 12 5 3 0 -6 -2 -9 -64 0 9 12 7 5 6 1 5 -4 5 -8 7 -9 8 -9 10 -8 12 -6 -64 0 9 12 8 8 7 3 6 -4 6 -8 7 -9 -64 -64 2564 81 -16 -9 12 -11 12 0 12 -1 8 -3 2 -5 -3 -6 -5 -8 -8 -10 -9 -12 -9 -13 -8 -13 -6 -12 -5 -11 -6 -12 -7 -64 0 0 12 0 7 1 -4 2 -9 -64 0 0 12 1 7 2 -4 2 -9 -64 0 14 11 13 10 14 9 15 10 15 11 14 12 12 12 10 11 8 8 7 6 5 1 3 -5 2 -9 -64 -64 2565 73 -16 -9 12 -10 11 1 12 -1 11 -3 9 -5 6 -6 4 -7 0 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -6 6 -3 7 -1 8 3 8 7 7 10 6 11 5 11 3 10 1 8 -1 4 -2 -1 -2 -4 -64 0 -1 11 -3 8 -5 4 -6 0 -6 -4 -5 -7 -3 -9 -64 -64 2566 111 -16 -9 12 -12 11 3 11 2 10 1 8 -1 3 -3 -3 -4 -5 -6 -8 -8 -9 -64 0 2 10 1 7 -1 -1 -2 -4 -3 -6 -5 -8 -8 -9 -10 -9 -11 -8 -11 -6 -10 -5 -9 -6 -10 -7 -64 0 -3 6 -4 4 -5 3 -7 3 -8 4 -8 6 -7 8 -5 10 -3 11 0 12 4 12 7 11 8 10 9 8 9 5 8 3 7 2 4 1 2 1 0 2 -64 0 4 12 6 11 7 10 8 8 8 5 7 3 6 2 4 1 -64 -64 2567 91 -16 -9 12 -10 11 3 8 3 6 2 4 1 3 -1 2 -3 2 -4 4 -4 6 -3 9 -1 11 2 12 5 12 7 11 8 9 8 5 7 2 5 -1 1 -5 -2 -7 -4 -8 -7 -9 -9 -9 -10 -8 -10 -6 -9 -5 -7 -5 -5 -6 -2 -8 1 -9 4 -9 6 -8 8 -6 -64 0 5 12 6 11 7 9 7 5 6 2 4 -1 1 -4 -3 -7 -7 -9 -64 -64 2568 135 -16 -9 12 -12 12 3 11 2 10 1 8 -1 3 -3 -3 -4 -5 -6 -8 -8 -9 -64 0 2 10 1 7 -1 -1 -2 -4 -3 -6 -5 -8 -8 -9 -10 -9 -11 -8 -11 -6 -10 -5 -9 -6 -10 -7 -64 0 -3 6 -4 4 -5 3 -7 3 -8 4 -8 6 -7 8 -5 10 -3 11 0 12 5 12 8 11 9 9 9 7 8 5 7 4 4 3 0 3 -64 0 5 12 7 11 8 9 8 7 7 5 6 4 4 3 -64 0 0 3 3 2 4 0 5 -7 6 -9 -64 0 0 3 2 2 3 0 4 -7 6 -9 7 -9 9 -8 11 -6 -64 -64 2569 77 -16 -9 12 -10 10 -4 9 -5 7 -5 5 -4 3 -2 2 1 2 4 3 6 4 9 7 10 10 10 11 9 12 8 12 6 11 5 10 4 8 3 5 1 -2 0 -5 -2 -8 -4 -9 -64 0 4 8 3 4 2 -3 1 -6 -1 -8 -4 -9 -7 -9 -9 -8 -10 -6 -10 -5 -9 -4 -8 -5 -9 -6 -64 -64 2570 81 -16 -9 12 -9 9 7 10 6 8 4 3 2 -3 1 -5 -1 -8 -3 -9 -64 0 1 6 0 4 -2 3 -4 3 -5 5 -5 7 -4 9 -2 11 1 12 10 12 8 11 7 10 6 7 4 -1 3 -4 2 -6 0 -8 -3 -9 -5 -9 -7 -8 -8 -7 -8 -6 -7 -5 -6 -6 -7 -7 -64 0 3 12 7 11 8 11 -64 -64 2571 83 -16 -9 12 -11 11 -10 8 -8 11 -6 12 -5 12 -3 10 -3 7 -4 4 -7 -4 -7 -7 -6 -9 -64 0 -5 12 -4 10 -4 7 -7 -1 -8 -4 -8 -7 -6 -9 -4 -9 -2 -8 1 -5 3 -2 4 0 -64 0 8 12 4 0 3 -4 3 -7 5 -9 6 -9 8 -8 10 -6 -64 0 9 12 5 0 4 -4 4 -7 5 -9 -64 -64 2572 77 -16 -9 12 -11 10 -10 8 -8 11 -6 12 -5 12 -3 10 -3 7 -4 3 -6 -4 -6 -7 -5 -9 -64 0 -5 12 -4 10 -4 7 -6 0 -7 -4 -7 -7 -5 -9 -4 -9 -1 -8 2 -5 4 -2 6 2 7 5 8 9 8 11 7 12 6 12 5 11 4 9 4 6 5 4 7 2 9 1 11 1 -64 -64 2573 87 -16 -9 12 -12 11 -9 6 -10 6 -11 7 -11 9 -10 11 -8 12 -4 12 -5 10 -6 6 -7 -3 -8 -9 -64 0 -6 6 -6 -3 -7 -9 -64 0 4 12 2 10 0 6 -3 -3 -5 -7 -7 -9 -64 0 4 12 3 10 2 6 1 -3 0 -9 -64 0 2 6 2 -3 1 -9 -64 0 14 12 12 11 10 9 8 6 5 -3 3 -7 1 -9 -64 -64 2574 109 -16 -9 12 -10 10 -2 7 -3 6 -5 6 -6 7 -6 9 -5 11 -3 12 -1 12 1 11 2 9 2 6 1 2 -1 -3 -3 -6 -5 -8 -8 -9 -10 -9 -11 -8 -11 -6 -10 -5 -9 -6 -10 -7 -64 0 -1 12 0 11 1 9 1 6 0 2 -2 -3 -4 -6 -6 -8 -8 -9 -64 0 11 11 10 10 11 9 12 10 12 11 11 12 9 12 7 11 5 9 3 6 1 2 0 -3 0 -6 1 -8 2 -9 3 -9 5 -8 7 -6 -64 -64 2575 89 -16 -9 12 -11 11 -8 8 -6 11 -4 12 -3 12 -1 11 -1 9 -3 3 -3 0 -2 -2 -64 0 -3 12 -2 11 -2 9 -4 3 -4 0 -2 -2 0 -2 3 -1 5 1 7 4 8 6 -64 0 10 12 8 6 5 -2 3 -6 -64 0 11 12 9 6 7 1 5 -3 3 -6 1 -8 -2 -9 -6 -9 -8 -8 -9 -6 -9 -5 -8 -4 -7 -5 -8 -6 -64 -64 2576 93 -16 -9 12 -11 10 8 10 7 8 5 3 4 0 3 -2 1 -5 -1 -7 -3 -8 -6 -9 -64 0 1 6 0 4 -2 3 -4 3 -5 5 -5 7 -4 9 -2 11 1 12 11 12 9 11 8 10 7 7 6 3 4 -3 2 -6 -1 -8 -6 -9 -10 -9 -11 -8 -11 -6 -10 -5 -8 -5 -6 -6 -3 -8 -1 -9 2 -9 5 -8 7 -6 -64 0 4 12 8 11 9 11 -64 -64 2601 77 -16 -9 12 -10 10 5 5 5 -9 6 -9 -64 0 5 5 6 5 6 -9 -64 0 5 2 3 4 1 5 -2 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 5 2 1 4 -2 4 -4 3 -5 2 -6 -1 -6 -3 -5 -6 -4 -7 -2 -8 1 -8 5 -6 -64 -64 2602 77 -16 -9 12 -10 10 -6 12 -6 -9 -5 -9 -64 0 -6 12 -5 12 -5 -9 -64 0 -5 2 -3 4 -1 5 2 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 2 -9 -1 -9 -3 -8 -5 -6 -64 0 -5 2 -1 4 2 4 4 3 5 2 6 -1 6 -3 5 -6 4 -7 2 -8 -1 -8 -5 -6 -64 -64 2603 69 -16 -9 12 -9 9 6 2 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 0 6 2 5 1 4 3 2 4 -1 4 -3 3 -4 2 -5 -1 -5 -3 -4 -6 -3 -7 -1 -8 2 -8 4 -7 5 -5 6 -6 -64 -64 2604 77 -16 -9 12 -10 10 5 12 5 -9 6 -9 -64 0 5 12 6 12 6 -9 -64 0 5 2 3 4 1 5 -2 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 5 2 1 4 -2 4 -4 3 -5 2 -6 -1 -6 -3 -5 -6 -4 -7 -2 -8 1 -8 5 -6 -64 -64 2605 77 -16 -9 12 -9 9 -5 -2 6 -2 6 1 5 3 4 4 2 5 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 -64 0 -5 -1 5 -1 5 1 4 3 2 4 -1 4 -3 3 -4 2 -5 -1 -5 -3 -4 -6 -3 -7 -1 -8 2 -8 4 -7 5 -5 6 -6 -64 -64 2606 53 -16 -9 12 -6 8 5 12 3 12 1 11 0 8 0 -9 1 -9 -64 0 5 12 5 11 3 11 1 10 -64 0 2 11 1 8 1 -9 -64 0 -3 5 4 5 4 4 -64 0 -3 5 -3 4 4 4 -64 -64 2607 101 -16 -9 12 -10 10 6 5 5 5 5 -10 4 -13 3 -14 1 -15 -1 -15 -3 -14 -4 -13 -6 -13 -64 0 6 5 6 -10 5 -13 3 -15 1 -16 -2 -16 -4 -15 -6 -13 -64 0 5 2 3 4 1 5 -2 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 5 2 1 4 -2 4 -4 3 -5 2 -6 -1 -6 -3 -5 -6 -4 -7 -2 -8 1 -8 5 -6 -64 -64 2608 55 -16 -9 12 -10 10 -6 12 -6 -9 -5 -9 -64 0 -6 12 -5 12 -5 -9 -64 0 -5 1 -2 4 0 5 3 5 5 4 6 1 6 -9 -64 0 -5 1 -2 3 0 4 2 4 4 3 5 1 5 -9 6 -9 -64 -64 2609 53 -16 -9 12 -4 5 0 12 -1 11 -1 10 0 9 1 9 2 10 2 11 1 12 0 12 -64 0 0 11 0 10 1 10 1 11 0 11 -64 0 0 5 0 -9 1 -9 -64 0 0 5 1 5 1 -9 -64 -64 2610 53 -16 -9 12 -4 5 0 12 -1 11 -1 10 0 9 1 9 2 10 2 11 1 12 0 12 -64 0 0 11 0 10 1 10 1 11 0 11 -64 0 0 5 0 -16 1 -16 -64 0 0 5 1 5 1 -16 -64 -64 2611 49 -16 -9 12 -10 9 -6 12 -6 -9 -5 -9 -64 0 -6 12 -5 12 -5 -9 -64 0 6 5 5 5 -5 -5 -64 0 6 5 -5 -6 -64 0 -2 -2 4 -9 6 -9 -64 0 -1 -1 6 -9 -64 -64 2612 21 -16 -9 12 -4 5 0 12 0 -9 1 -9 -64 0 0 12 1 12 1 -9 -64 -64 2613 89 -16 -9 12 -15 16 -11 5 -11 -9 -10 -9 -64 0 -11 5 -10 5 -10 -9 -64 0 -10 1 -7 4 -5 5 -2 5 0 4 1 1 1 -9 -64 0 -10 1 -7 3 -5 4 -3 4 -1 3 0 1 0 -9 1 -9 -64 0 1 1 4 4 6 5 9 5 11 4 12 1 12 -9 -64 0 1 1 4 3 6 4 8 4 10 3 11 1 11 -9 12 -9 -64 -64 2614 55 -16 -9 12 -10 10 -6 5 -6 -9 -5 -9 -64 0 -6 5 -5 5 -5 -9 -64 0 -5 1 -2 4 0 5 3 5 5 4 6 1 6 -9 -64 0 -5 1 -2 3 0 4 2 4 4 3 5 1 5 -9 6 -9 -64 -64 2615 77 -16 -9 12 -9 10 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 2 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 2 5 -1 5 -64 0 -1 4 -3 3 -4 2 -5 -1 -5 -3 -4 -6 -3 -7 -1 -8 2 -8 4 -7 5 -6 6 -3 6 -1 5 2 4 3 2 4 -1 4 -64 -64 2616 77 -16 -9 12 -10 10 -6 5 -6 -16 -5 -16 -64 0 -6 5 -5 5 -5 -16 -64 0 -5 2 -3 4 -1 5 2 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 2 -9 -1 -9 -3 -8 -5 -6 -64 0 -5 2 -1 4 2 4 4 3 5 2 6 -1 6 -3 5 -6 4 -7 2 -8 -1 -8 -5 -6 -64 -64 2617 77 -16 -9 12 -10 10 5 5 5 -16 6 -16 -64 0 5 5 6 5 6 -16 -64 0 5 2 3 4 1 5 -2 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 5 2 1 4 -2 4 -4 3 -5 2 -6 -1 -6 -3 -5 -6 -4 -7 -2 -8 1 -8 5 -6 -64 -64 2618 47 -16 -9 12 -7 7 -3 5 -3 -9 -2 -9 -64 0 -3 5 -2 5 -2 -9 -64 0 -2 -1 -1 2 1 4 3 5 6 5 -64 0 -2 -1 -1 1 1 3 3 4 6 4 6 5 -64 -64 2619 105 -16 -9 12 -8 9 6 2 5 4 2 5 -1 5 -4 4 -5 2 -4 0 -2 -1 3 -3 5 -4 -64 0 4 -3 5 -5 5 -6 4 -8 -64 0 5 -7 2 -8 -1 -8 -4 -7 -64 0 -3 -8 -4 -6 -5 -6 -64 0 6 2 5 2 4 4 -64 0 5 3 2 4 -1 4 -4 3 -64 0 -3 4 -4 2 -3 0 -64 0 -4 1 -2 0 3 -2 5 -3 6 -5 6 -6 5 -8 2 -9 -1 -9 -4 -8 -5 -6 -64 -64 2620 37 -16 -9 12 -5 6 0 12 0 -9 1 -9 -64 0 0 12 1 12 1 -9 -64 0 -3 5 4 5 4 4 -64 0 -3 5 -3 4 4 4 -64 -64 2621 55 -16 -9 12 -10 10 -6 5 -6 -5 -5 -8 -3 -9 0 -9 2 -8 5 -5 -64 0 -6 5 -5 5 -5 -5 -4 -7 -2 -8 0 -8 2 -7 5 -5 -64 0 5 5 5 -9 6 -9 -64 0 5 5 6 5 6 -9 -64 -64 2622 33 -16 -9 12 -8 8 -6 5 0 -9 -64 0 -6 5 -5 5 0 -7 -64 0 6 5 5 5 0 -7 -64 0 6 5 0 -9 -64 -64 2623 57 -16 -9 12 -12 12 -9 5 -4 -9 -64 0 -9 5 -8 5 -4 -6 -64 0 0 5 -4 -6 -64 0 0 2 -4 -9 -64 0 0 2 4 -9 -64 0 0 5 4 -6 -64 0 9 5 8 5 4 -6 -64 0 9 5 4 -9 -64 -64 2624 37 -16 -9 12 -9 9 -6 5 5 -9 6 -9 -64 0 -6 5 -5 5 6 -9 -64 0 6 5 5 5 -6 -9 -64 0 6 5 -5 -9 -6 -9 -64 -64 2625 39 -16 -9 12 -8 8 -6 5 0 -9 -64 0 -6 5 -5 5 0 -7 -64 0 6 5 5 5 0 -7 -4 -16 -64 0 6 5 0 -9 -3 -16 -4 -16 -64 -64 2626 45 -16 -9 12 -9 9 4 4 -6 -9 -64 0 6 5 -4 -8 -64 0 -6 5 6 5 -64 0 -6 5 -6 4 4 4 -64 0 -4 -8 6 -8 6 -9 -64 0 -6 -9 6 -9 -64 -64 2651 71 -16 -9 12 -7 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -6 -64 0 -2 0 -4 -2 -5 -4 -5 -7 -3 -9 -64 0 4 0 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 0 5 0 3 -6 3 -8 4 -9 -64 -64 2652 51 -16 -9 12 -6 8 -6 -4 -4 -1 -2 3 -64 0 1 12 -5 -6 -5 -8 -3 -9 -2 -9 0 -8 2 -6 3 -3 3 0 4 -4 5 -5 6 -5 8 -4 -64 0 2 12 -4 -6 -4 -8 -3 -9 -64 -64 2653 49 -16 -9 12 -6 6 2 -1 1 -2 2 -2 2 -1 1 0 -1 0 -3 -1 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 1 -9 4 -7 6 -4 -64 0 -1 0 -3 -2 -4 -4 -4 -7 -2 -9 -64 -64 2654 71 -16 -9 12 -7 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -6 -64 0 -2 0 -4 -2 -5 -4 -5 -7 -3 -9 -64 0 8 12 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 0 9 12 3 -6 3 -8 4 -9 -64 -64 2655 51 -16 -9 12 -6 6 -3 -7 -1 -6 0 -5 1 -3 1 -1 0 0 -1 0 -3 -1 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 1 -9 4 -7 6 -4 -64 0 -1 0 -3 -2 -4 -4 -4 -7 -2 -9 -64 -64 2656 59 -16 -9 12 -3 6 0 0 3 3 5 6 6 9 6 11 5 12 3 11 2 9 -7 -18 -7 -20 -6 -21 -4 -20 -3 -17 -2 -8 -1 -9 1 -9 3 -8 4 -7 6 -4 -64 0 2 9 1 4 0 0 -3 -9 -5 -14 -7 -18 -64 -64 2657 81 -16 -9 12 -7 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -6 -64 0 -2 0 -4 -2 -5 -4 -5 -7 -3 -9 -64 0 4 0 -2 -18 -64 0 5 0 2 -9 0 -14 -2 -18 -3 -20 -5 -21 -6 -20 -6 -18 -5 -15 -3 -13 0 -11 4 -9 7 -7 9 -4 -64 -64 2658 65 -16 -9 12 -6 9 -6 -4 -4 -1 -2 3 -64 0 1 12 -6 -9 -64 0 2 12 -5 -9 -64 0 -3 -3 -1 -1 1 0 2 0 4 -1 4 -3 3 -6 3 -8 4 -9 -64 0 2 0 3 -1 3 -3 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 -64 2659 43 -16 -9 12 -4 4 1 6 0 5 1 4 2 5 1 6 -64 0 -1 0 -3 -6 -3 -8 -1 -9 1 -8 2 -7 4 -4 -64 0 0 0 -2 -6 -2 -8 -1 -9 -64 -64 2660 53 -16 -9 12 -4 4 1 6 0 5 1 4 2 5 1 6 -64 0 -1 0 -7 -18 -64 0 0 0 -3 -9 -5 -14 -7 -18 -8 -20 -10 -21 -11 -20 -11 -18 -10 -15 -8 -13 -5 -11 -1 -9 2 -7 4 -4 -64 -64 2661 67 -16 -9 12 -6 8 -6 -4 -4 -1 -2 3 -64 0 1 12 -6 -9 -64 0 2 12 -5 -9 -64 0 3 0 3 -1 4 -1 3 0 2 0 0 -2 -3 -3 -64 0 -3 -3 0 -4 1 -8 2 -9 -64 0 -3 -3 -1 -4 0 -8 2 -9 3 -9 6 -7 8 -4 -64 -64 2662 39 -16 -9 12 -4 4 -4 -4 -2 -1 0 3 -64 0 3 12 -3 -6 -3 -8 -1 -9 1 -8 2 -7 4 -4 -64 0 4 12 -2 -6 -2 -8 -1 -9 -64 -64 2663 95 -16 -9 12 -13 12 -13 -4 -11 -1 -9 0 -7 -1 -7 -3 -9 -9 -64 0 -9 0 -8 -1 -8 -3 -10 -9 -64 0 -7 -3 -5 -1 -3 0 -2 0 0 -1 0 -3 -2 -9 -64 0 -2 0 -1 -1 -1 -3 -3 -9 -64 0 0 -3 2 -1 4 0 5 0 7 -1 7 -3 6 -6 6 -8 7 -9 -64 0 5 0 6 -1 6 -3 5 -6 5 -8 7 -9 9 -8 10 -7 12 -4 -64 -64 2664 69 -16 -9 12 -9 9 -9 -4 -7 -1 -5 0 -3 -1 -3 -3 -5 -9 -64 0 -5 0 -4 -1 -4 -3 -6 -9 -64 0 -3 -3 -1 -1 1 0 2 0 4 -1 4 -3 3 -6 3 -8 4 -9 -64 0 2 0 3 -1 3 -3 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 -64 2665 63 -16 -9 12 -7 7 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 2 -7 3 -5 3 -3 2 -1 0 0 -1 -1 -1 -3 0 -5 2 -6 4 -6 6 -5 7 -4 -64 0 -2 0 -4 -2 -5 -4 -5 -7 -3 -9 -64 -64 2666 65 -16 -9 12 -6 9 -6 -4 -4 -1 -2 3 -64 0 -1 6 -10 -21 -64 0 0 6 -9 -21 -64 0 -3 -3 -1 -1 1 0 2 0 4 -1 4 -3 3 -6 3 -8 4 -9 -64 0 2 0 3 -1 3 -3 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 -64 2667 75 -16 -9 12 -7 9 3 -3 2 -1 0 0 -2 0 -4 -1 -5 -2 -6 -4 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 -64 0 -2 0 -4 -2 -5 -4 -5 -7 -3 -9 -64 0 4 0 -2 -18 -2 -20 -1 -21 1 -20 2 -17 2 -9 4 -9 7 -7 9 -4 -64 0 5 0 2 -9 0 -14 -2 -18 -64 -64 2668 53 -16 -9 12 -6 8 -6 -4 -4 -1 -2 0 0 -1 0 -3 -2 -9 -64 0 -2 0 -1 -1 -1 -3 -3 -9 -64 0 0 -3 2 -1 4 0 5 0 4 -3 -64 0 4 0 4 -3 5 -5 6 -5 8 -4 -64 -64 2669 49 -16 -9 12 -4 8 -4 -4 -2 -1 -1 1 -1 -1 2 -3 3 -5 3 -7 2 -8 0 -9 -64 0 -1 -1 1 -3 2 -5 2 -7 0 -9 -64 0 -4 -8 -2 -9 3 -9 6 -7 8 -4 -64 -64 2670 45 -16 -9 12 -4 4 -4 -4 -2 -1 0 3 -64 0 3 12 -3 -6 -3 -8 -1 -9 1 -8 2 -7 4 -4 -64 0 4 12 -2 -6 -2 -8 -1 -9 -64 0 -2 4 4 4 -64 -64 2671 59 -16 -9 12 -7 9 -4 0 -6 -6 -6 -8 -4 -9 -3 -9 -1 -8 1 -6 3 -3 -64 0 -3 0 -5 -6 -5 -8 -4 -9 -64 0 4 0 2 -6 2 -8 4 -9 6 -8 7 -7 9 -4 -64 0 5 0 3 -6 3 -8 4 -9 -64 -64 2672 51 -16 -9 12 -7 8 -4 0 -5 -2 -6 -5 -6 -8 -4 -9 -3 -9 0 -8 2 -6 3 -3 3 0 -64 0 -3 0 -4 -2 -5 -5 -5 -8 -4 -9 -64 0 3 0 4 -4 5 -5 6 -5 8 -4 -64 -64 2673 77 -16 -9 12 -10 11 -6 0 -8 -2 -9 -5 -9 -8 -7 -9 -6 -9 -4 -8 -2 -6 -64 0 -5 0 -7 -2 -8 -5 -8 -8 -7 -9 -64 0 0 0 -2 -6 -2 -8 0 -9 1 -9 3 -8 5 -6 6 -3 6 0 -64 0 1 0 -1 -6 -1 -8 0 -9 -64 0 6 0 7 -4 8 -5 9 -5 11 -4 -64 -64 2674 89 -16 -9 12 -8 8 -8 -4 -6 -1 -4 0 -2 0 -1 -1 -1 -3 -2 -6 -3 -8 -5 -9 -6 -9 -7 -8 -7 -7 -6 -7 -7 -8 -64 0 5 -1 4 -2 5 -2 5 -1 4 0 3 0 1 -1 0 -3 -1 -6 -1 -8 0 -9 3 -9 6 -7 8 -4 -64 0 -1 -1 0 -3 -64 0 1 -1 -1 -3 -64 0 -2 -6 -1 -8 -64 0 -1 -6 -3 -8 -64 -64 2675 69 -16 -9 12 -7 9 -4 0 -6 -6 -6 -8 -4 -9 -3 -9 -1 -8 1 -6 3 -3 -64 0 -3 0 -5 -6 -5 -8 -4 -9 -64 0 4 0 -2 -18 -64 0 5 0 2 -9 0 -14 -2 -18 -3 -20 -5 -21 -6 -20 -6 -18 -5 -15 -3 -13 0 -11 4 -9 7 -7 9 -4 -64 -64 2676 81 -16 -9 12 -6 7 -6 -4 -4 -1 -2 0 0 0 2 -1 2 -4 1 -6 -2 -8 -4 -9 -64 0 0 0 1 -1 1 -4 0 -6 -2 -8 -64 0 -4 -9 -2 -10 -1 -12 -1 -15 -2 -18 -4 -20 -6 -21 -7 -20 -7 -18 -6 -15 -3 -12 0 -10 4 -7 7 -4 -64 0 -4 -9 -3 -10 -2 -12 -2 -15 -3 -18 -4 -20 -64 -64 2697 9 -16 -9 12 0 0 -64 0 -64 -64 2698 9 -16 -9 12 -4 4 -64 0 -64 -64 2699 9 -16 -9 12 -8 8 -64 0 -64 -64 2700 89 -16 -9 12 -10 10 -1 12 -4 11 -6 8 -7 3 -7 0 -6 -5 -4 -8 -1 -9 1 -9 4 -8 6 -5 7 0 7 3 6 8 4 11 1 12 -1 12 -64 0 -3 11 -5 8 -6 3 -6 0 -5 -5 -3 -8 -64 0 -4 -7 -1 -8 1 -8 4 -7 -64 0 3 -8 5 -5 6 0 6 3 5 8 3 11 -64 0 4 10 1 11 -1 11 -4 10 -64 -64 2701 29 -16 -9 12 -10 10 -4 8 -2 9 1 12 1 -9 -64 0 -4 8 -4 7 -2 8 0 10 0 -9 1 -9 -64 -64 2702 73 -16 -9 12 -10 10 -6 7 -6 8 -5 10 -4 11 -2 12 2 12 4 11 5 10 6 8 6 6 5 4 3 1 -6 -9 -64 0 -6 7 -5 7 -5 8 -4 10 -2 11 2 11 4 10 5 8 5 6 4 4 2 1 -7 -9 -64 0 -6 -8 7 -8 7 -9 -64 0 -7 -9 7 -9 -64 -64 2703 101 -16 -9 12 -10 10 -5 12 6 12 -1 3 -64 0 -5 12 -5 11 5 11 -64 0 5 12 -2 3 -64 0 -1 4 1 4 4 3 6 1 7 -2 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -6 -5 -64 0 -2 3 1 3 4 2 6 -1 -64 0 2 3 5 1 6 -2 6 -3 5 -6 2 -8 -64 0 6 -4 4 -7 1 -8 -2 -8 -5 -7 -6 -5 -64 0 -3 -8 -6 -6 -64 -64 2704 41 -16 -9 12 -10 10 3 9 3 -9 4 -9 -64 0 4 12 4 -9 -64 0 4 12 -7 -4 8 -4 -64 0 3 9 -6 -4 -64 0 -6 -3 8 -3 8 -4 -64 -64 2705 111 -16 -9 12 -10 10 -5 12 -6 3 -64 0 -4 11 -5 4 -64 0 -5 12 5 12 5 11 -64 0 -4 11 5 11 -64 0 -5 4 -2 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -6 -5 -64 0 -6 3 -5 3 -3 4 1 4 4 3 6 0 -64 0 2 4 5 2 6 -1 6 -3 5 -6 2 -8 -64 0 6 -4 4 -7 1 -8 -2 -8 -5 -7 -6 -5 -64 0 -3 -8 -6 -6 -64 -64 2706 129 -16 -9 12 -10 10 4 11 5 9 6 9 5 11 2 12 0 12 -3 11 -5 8 -6 3 -6 -2 -5 -6 -3 -8 0 -9 1 -9 4 -8 6 -6 7 -3 7 -2 6 1 4 3 1 4 0 4 -3 3 -5 1 -64 0 5 10 2 11 0 11 -3 10 -64 0 -2 11 -4 8 -5 3 -5 -2 -4 -6 -1 -8 -64 0 -5 -4 -3 -7 0 -8 1 -8 4 -7 6 -4 -64 0 2 -8 5 -6 6 -3 6 -2 5 1 2 3 -64 0 6 -1 4 2 1 3 0 3 -3 2 -5 -1 -64 0 -1 3 -4 1 -5 -2 -64 -64 2707 29 -16 -9 12 -10 10 -7 12 7 12 -3 -9 -64 0 -7 12 -7 11 6 11 -64 0 6 12 -4 -9 -3 -9 -64 -64 2708 141 -16 -9 12 -10 10 -2 12 -5 11 -6 9 -6 7 -5 5 -4 4 -2 3 2 2 4 1 5 0 6 -2 6 -5 5 -7 2 -8 -2 -8 -5 -7 -6 -5 -6 -2 -5 0 -4 1 -2 2 2 3 4 4 5 5 6 7 6 9 5 11 2 12 -2 12 -64 0 -4 11 -5 9 -5 7 -4 5 -2 4 2 3 4 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -2 -6 0 -4 2 -2 3 2 4 4 5 5 7 5 9 4 11 -64 0 5 10 2 11 -2 11 -5 10 -64 0 -6 -6 -3 -8 -64 0 3 -8 6 -6 -64 -64 2709 129 -16 -9 12 -10 10 5 2 3 0 0 -1 -1 -1 -4 0 -6 2 -7 5 -7 6 -6 9 -4 11 -1 12 0 12 3 11 5 9 6 5 6 0 5 -5 3 -8 0 -9 -2 -9 -5 -8 -6 -6 -5 -6 -4 -8 -64 0 5 5 4 2 1 0 -64 0 5 4 3 1 0 0 -1 0 -4 1 -6 4 -64 0 -2 0 -5 2 -6 5 -6 6 -5 9 -2 11 -64 0 -6 7 -4 10 -1 11 0 11 3 10 5 7 -64 0 1 11 4 9 5 5 5 0 4 -5 2 -8 -64 0 3 -7 0 -8 -2 -8 -5 -7 -64 -64 2710 37 -16 -9 12 -5 6 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 2711 53 -16 -9 12 -5 6 2 -8 1 -9 0 -9 -1 -8 -1 -7 0 -6 1 -6 2 -7 2 -10 1 -12 -1 -13 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 0 1 -9 2 -10 -64 0 2 -8 1 -12 -64 -64 2712 69 -16 -9 12 -5 6 0 5 -1 4 -1 3 0 2 1 2 2 3 2 4 1 5 0 5 -64 0 0 4 0 3 1 3 1 4 0 4 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 2713 85 -16 -9 12 -5 6 0 5 -1 4 -1 3 0 2 1 2 2 3 2 4 1 5 0 5 -64 0 0 4 0 3 1 3 1 4 0 4 -64 0 2 -8 1 -9 0 -9 -1 -8 -1 -7 0 -6 1 -6 2 -7 2 -10 1 -12 -1 -13 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 0 1 -9 2 -10 -64 0 2 -8 1 -12 -64 -64 2714 53 -16 -9 12 -5 6 0 12 0 -2 1 -2 -64 0 0 12 1 12 1 -2 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 2715 121 -16 -9 12 -9 10 -6 7 -6 8 -5 10 -4 11 -1 12 2 12 5 11 6 10 7 8 7 6 6 4 5 3 3 2 0 1 -64 0 -6 7 -5 7 -5 8 -4 10 -1 11 2 11 5 10 6 8 6 6 5 4 3 3 0 2 -64 0 -5 9 -2 11 -64 0 3 11 6 9 -64 0 6 5 2 2 -64 0 0 2 0 -2 1 -2 1 2 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 2716 53 -16 -9 12 -5 6 2 12 0 11 -1 9 -1 6 0 5 1 5 2 6 2 7 1 8 0 8 -1 7 -64 0 0 7 0 6 1 6 1 7 0 7 -64 0 0 11 -1 7 -64 0 -1 9 0 8 -64 -64 2717 53 -16 -9 12 -5 6 2 10 1 9 0 9 -1 10 -1 11 0 12 1 12 2 11 2 8 1 6 -1 5 -64 0 0 11 0 10 1 10 1 11 0 11 -64 0 1 9 2 8 -64 0 2 10 1 6 -64 -64 2718 147 -16 -9 12 -12 13 10 5 8 5 6 4 5 2 3 -4 2 -6 1 -7 -1 -8 -5 -8 -7 -7 -8 -5 -8 -3 -7 -1 -6 0 -1 3 1 5 2 7 2 9 1 11 -1 12 -2 12 -4 11 -5 9 -5 7 -4 4 -2 1 3 -5 6 -8 8 -9 10 -9 -64 0 10 5 10 4 8 4 6 3 -64 0 7 4 6 2 4 -4 3 -6 1 -8 -1 -9 -5 -9 -7 -8 -8 -7 -9 -5 -9 -3 -8 -1 -6 1 -1 4 0 5 1 7 1 9 0 11 -64 0 1 10 -1 11 -2 11 -4 10 -64 0 -3 11 -4 9 -4 7 -3 4 -1 1 4 -5 6 -7 8 -8 10 -8 10 -9 -64 -64 2719 107 -16 -9 12 -9 10 0 16 0 -13 1 -13 -64 0 0 16 1 16 1 -13 -64 0 5 9 7 9 5 11 2 12 -1 12 -4 11 -6 9 -6 7 -5 5 -4 4 4 0 5 -1 6 -3 6 -5 5 -7 2 -8 -1 -8 -3 -7 -4 -6 -64 0 5 9 4 10 2 11 -1 11 -4 10 -5 9 -5 7 -4 5 4 1 6 -1 7 -3 7 -5 6 -7 5 -8 2 -9 -1 -9 -4 -8 -6 -6 -4 -6 -64 0 6 -6 3 -8 -64 -64 2720 21 -16 -9 12 -11 12 9 16 -9 -16 -8 -16 -64 0 9 16 10 16 -8 -16 -64 -64 2721 53 -16 -9 12 -7 7 3 16 1 14 -1 11 -3 7 -4 2 -4 -2 -3 -7 -1 -11 1 -14 3 -16 4 -16 -64 0 3 16 4 16 2 14 0 11 -2 7 -3 2 -3 -2 -2 -7 0 -11 2 -14 4 -16 -64 -64 2722 53 -16 -9 12 -7 7 -4 16 -2 14 0 11 2 7 3 2 3 -2 2 -7 0 -11 -2 -14 -4 -16 -3 -16 -64 0 -4 16 -3 16 -1 14 1 11 3 7 4 2 4 -2 3 -7 1 -11 -1 -14 -3 -16 -64 -64 2723 83 -16 -9 12 -8 8 0 12 -1 11 1 1 0 0 -64 0 0 12 0 0 -64 0 0 12 1 11 -1 1 0 0 -64 0 -5 9 -4 9 4 3 5 3 -64 0 -5 9 5 3 -64 0 -5 9 -5 8 5 4 5 3 -64 0 5 9 4 9 -4 3 -5 3 -64 0 5 9 -5 3 -64 0 5 9 5 8 -5 4 -5 3 -64 -64 2724 21 -16 -9 12 -12 13 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 2725 37 -16 -9 12 -12 13 0 9 0 -8 1 -8 -64 0 0 9 1 9 1 -8 -64 0 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 2726 37 -16 -9 12 -12 13 -8 5 9 5 9 4 -64 0 -8 5 -8 4 9 4 -64 0 -8 -3 9 -3 9 -4 -64 0 -8 -3 -8 -4 9 -4 -64 -64 2727 27 -16 -9 12 -4 5 1 12 0 11 0 5 -64 0 1 11 0 5 -64 0 1 12 2 11 0 5 -64 -64 2728 49 -16 -9 12 -9 9 -4 12 -5 11 -5 5 -64 0 -4 11 -5 5 -64 0 -4 12 -3 11 -5 5 -64 0 5 12 4 11 4 5 -64 0 5 11 4 5 -64 0 5 12 6 11 4 5 -64 -64 2729 65 -16 -9 12 -7 7 -1 12 -3 11 -4 9 -4 7 -3 5 -1 4 1 4 3 5 4 7 4 9 3 11 1 12 -1 12 -64 0 -1 12 -4 9 -3 5 1 4 4 7 3 11 -1 12 -64 0 1 12 -3 11 -4 7 -1 4 3 5 4 9 1 12 -64 -64 2747 9 -16 -9 12 0 0 -64 0 -64 -64 2748 9 -16 -9 12 -4 4 -64 0 -64 -64 2749 9 -16 -9 12 -8 8 -64 0 -64 -64 2750 89 -16 -9 12 -10 11 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 2 12 -64 0 2 12 0 11 -2 9 -4 6 -5 3 -6 -1 -6 -4 -5 -7 -3 -9 -64 0 -1 -9 1 -8 3 -6 5 -3 6 0 7 4 7 7 6 10 4 12 -64 -64 2751 35 -16 -9 12 -10 11 2 8 -3 -9 -64 0 4 12 -2 -9 -64 0 4 12 1 9 -2 7 -4 6 -64 0 3 9 -1 7 -4 6 -64 -64 2752 89 -16 -9 12 -10 11 -3 8 -2 7 -3 6 -4 7 -4 8 -3 10 -2 11 1 12 4 12 7 11 8 9 8 7 7 5 5 3 2 1 -2 -1 -5 -3 -7 -5 -9 -9 -64 0 4 12 6 11 7 9 7 7 6 5 4 3 -2 -1 -64 0 -8 -7 -7 -6 -5 -6 0 -8 3 -8 5 -7 6 -5 -64 0 -5 -6 0 -9 3 -9 5 -8 6 -5 -64 -64 2753 105 -16 -9 12 -10 11 -3 8 -2 7 -3 6 -4 7 -4 8 -3 10 -2 11 1 12 4 12 7 11 8 9 8 7 7 5 4 3 1 2 -64 0 4 12 6 11 7 9 7 7 6 5 4 3 -64 0 -1 2 1 2 4 1 5 0 6 -2 6 -5 5 -7 4 -8 1 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -4 -7 -3 -6 -4 -7 -5 -64 0 1 2 3 1 4 0 5 -2 5 -5 4 -7 3 -8 1 -9 -64 -64 2754 25 -16 -9 12 -10 11 6 11 0 -9 -64 0 7 12 1 -9 -64 0 7 12 -8 -3 8 -3 -64 -64 2755 83 -16 -9 12 -10 11 -1 12 -6 2 -64 0 -1 12 9 12 -64 0 -1 11 4 11 9 12 -64 0 -6 2 -5 3 -2 4 1 4 4 3 5 2 6 0 6 -3 5 -6 3 -8 0 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -4 -7 -3 -6 -4 -7 -5 -64 0 1 4 3 3 4 2 5 0 5 -3 4 -6 2 -8 0 -9 -64 -64 2756 97 -16 -9 12 -10 11 7 9 6 8 7 7 8 8 8 9 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -5 -6 -7 -5 -8 -3 -9 0 -9 3 -8 5 -6 6 -4 6 -1 5 1 4 2 2 3 -1 3 -3 2 -5 0 -6 -2 -64 0 2 12 0 11 -2 9 -4 6 -5 3 -6 -1 -6 -6 -5 -8 -64 0 0 -9 2 -8 4 -6 5 -4 5 0 4 2 -64 -64 2757 65 -16 -9 12 -10 11 -4 12 -6 6 -64 0 9 12 8 9 6 6 1 0 -1 -3 -2 -5 -3 -9 -64 0 6 6 0 0 -2 -3 -3 -5 -4 -9 -64 0 -5 9 -2 12 0 12 5 9 -64 0 -4 10 -2 11 0 11 5 9 7 9 8 10 9 12 -64 -64 2758 131 -16 -9 12 -10 11 1 12 -2 11 -3 10 -4 8 -4 5 -3 3 -1 2 2 2 6 3 7 4 8 6 8 9 7 11 4 12 1 12 -64 0 1 12 -1 11 -2 10 -3 8 -3 5 -2 3 -1 2 -64 0 2 2 5 3 6 4 7 6 7 9 6 11 4 12 -64 0 -1 2 -5 1 -7 -1 -8 -3 -8 -6 -7 -8 -4 -9 0 -9 4 -8 5 -7 6 -5 6 -2 5 0 4 1 2 2 -64 0 -1 2 -4 1 -6 -1 -7 -3 -7 -6 -6 -8 -4 -9 -64 0 0 -9 3 -8 4 -7 5 -5 5 -1 4 1 -64 -64 2759 97 -16 -9 12 -10 11 7 5 6 3 4 1 2 0 -1 0 -3 1 -4 2 -5 4 -5 7 -4 9 -2 11 1 12 4 12 6 11 7 10 8 8 8 4 7 0 6 -3 4 -6 2 -8 -1 -9 -4 -9 -6 -8 -7 -6 -7 -5 -6 -4 -5 -5 -6 -6 -64 0 -3 1 -4 3 -4 7 -3 9 -1 11 1 12 -64 0 6 11 7 9 7 4 6 0 5 -3 3 -6 1 -8 -1 -9 -64 -64 2760 17 -16 -9 12 -5 6 -2 -7 -3 -8 -2 -9 -1 -8 -2 -7 -64 -64 2761 21 -16 -9 12 -5 6 -2 -9 -3 -8 -2 -7 -1 -8 -1 -9 -2 -11 -4 -13 -64 -64 2762 27 -16 -9 12 -5 6 1 5 0 4 1 3 2 4 1 5 -64 0 -2 -7 -3 -8 -2 -9 -1 -8 -64 -64 2763 33 -16 -9 12 -5 6 1 5 0 4 1 3 2 4 1 5 -64 0 -2 -9 -3 -8 -2 -7 -1 -8 -1 -9 -2 -11 -4 -13 -64 -64 2764 39 -16 -9 12 -5 6 3 12 2 11 0 -1 -64 0 3 11 0 -1 -64 0 3 12 4 11 0 -1 -64 0 -2 -7 -3 -8 -2 -9 -1 -8 -2 -7 -64 -64 2765 73 -16 -9 12 -10 11 -3 8 -2 7 -3 6 -4 7 -4 8 -3 10 -2 11 1 12 5 12 8 11 9 9 9 7 8 5 7 4 1 2 -1 1 -1 -1 0 -2 2 -2 -64 0 5 12 7 11 8 9 8 7 7 5 6 4 4 3 -64 0 -2 -7 -3 -8 -2 -9 -1 -8 -2 -7 -64 -64 2766 21 -16 -9 12 -5 6 4 12 2 10 1 8 1 7 2 6 3 7 2 8 -64 -64 2767 21 -16 -9 12 -5 6 3 10 2 11 3 12 4 11 4 10 3 8 1 6 -64 -64 2768 115 -16 -9 12 -13 13 10 4 9 3 10 2 11 3 11 4 10 5 9 5 7 4 5 2 0 -6 -2 -8 -4 -9 -7 -9 -10 -8 -11 -6 -11 -4 -10 -2 -9 -1 -7 0 -2 2 0 3 2 5 3 7 3 9 2 11 0 12 -2 11 -3 9 -3 6 -2 0 -1 -3 1 -6 3 -8 5 -9 7 -9 8 -7 8 -6 -64 0 -7 -9 -9 -8 -10 -6 -10 -4 -9 -2 -8 -1 -2 2 -64 0 -3 6 -2 1 -1 -2 1 -5 3 -7 5 -8 7 -8 8 -7 -64 -64 2769 87 -16 -9 12 -10 11 2 16 -6 -13 -64 0 7 16 -1 -13 -64 0 8 8 7 7 8 6 9 7 9 8 8 10 7 11 4 12 0 12 -3 11 -5 9 -5 7 -4 5 -3 4 4 0 6 -2 -64 0 -5 7 -3 5 4 1 5 0 6 -2 6 -5 5 -7 4 -8 1 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -4 -7 -3 -6 -4 -7 -5 -64 -64 2770 11 -16 -9 12 -11 11 13 16 -13 -16 -64 -64 2771 45 -16 -9 12 -7 8 8 16 4 13 1 10 -1 7 -3 3 -4 -2 -4 -6 -3 -11 -2 -14 -1 -16 -64 0 4 13 1 9 -1 5 -2 2 -3 -3 -3 -8 -2 -13 -1 -16 -64 -64 2772 45 -16 -9 12 -8 7 1 16 2 14 3 11 4 6 4 2 3 -3 1 -7 -1 -10 -4 -13 -8 -16 -64 0 1 16 2 13 3 8 3 3 2 -2 1 -5 -1 -9 -4 -13 -64 -64 2773 23 -16 -9 12 -8 9 2 12 2 0 -64 0 -3 9 7 3 -64 0 7 9 -3 3 -64 -64 2774 11 -16 -9 12 -13 13 -9 0 9 0 -64 -64 2775 17 -16 -9 12 -13 13 0 9 0 -9 -64 0 -9 0 9 0 -64 -64 2776 17 -16 -9 12 -13 13 -9 3 9 3 -64 0 -9 -3 9 -3 -64 -64 2777 17 -16 -9 12 -4 5 3 12 1 5 -64 0 4 12 1 5 -64 -64 2778 29 -16 -9 12 -9 9 -2 12 -4 5 -64 0 -1 12 -4 5 -64 0 7 12 5 5 -64 0 8 12 5 5 -64 -64 2779 33 -16 -9 12 -7 8 1 12 -1 11 -2 9 -2 7 -1 5 1 4 3 4 5 5 6 7 6 9 5 11 3 12 1 12 -64 -64 2801 41 -16 -9 12 -10 10 0 12 -7 -9 -64 0 0 12 7 -9 -64 0 0 9 6 -9 -64 0 -5 -3 4 -3 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2802 67 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 7 12 7 6 6 12 -64 0 -5 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -9 -9 -64 0 3 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 -64 -64 2803 95 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -64 0 3 12 5 11 6 10 7 8 7 6 6 4 5 3 3 2 -64 0 -5 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -9 -9 -64 0 3 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 -64 -64 2804 33 -16 -9 12 -9 9 -4 12 -4 -9 -64 0 -3 12 -3 -9 -64 0 -7 12 8 12 8 6 7 12 -64 0 -7 -9 0 -9 -64 -64 2805 67 -16 -9 12 -12 12 -4 12 -4 6 -5 -2 -6 -6 -7 -8 -8 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -7 12 10 12 -64 0 -11 -9 10 -9 -64 0 -11 -9 -11 -16 -64 0 -10 -9 -11 -16 -64 0 9 -9 10 -16 -64 0 10 -9 10 -16 -64 -64 2806 49 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 1 6 1 -2 -64 0 -9 12 7 12 7 6 6 12 -64 0 -5 2 1 2 -64 0 -9 -9 7 -9 7 -3 6 -9 -64 -64 2807 147 -16 -9 12 -15 16 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -3 12 4 12 -64 0 -11 11 -10 10 -11 9 -12 10 -12 11 -11 12 -10 12 -9 11 -8 9 -7 5 -6 3 -4 2 5 2 7 3 8 5 9 9 10 11 11 12 12 12 13 11 13 10 12 9 11 10 12 11 -64 0 -4 2 -6 1 -7 -1 -8 -6 -9 -8 -10 -9 -64 0 -4 2 -5 1 -6 -1 -7 -6 -8 -8 -9 -9 -11 -9 -12 -8 -13 -6 -64 0 5 2 7 1 8 -1 9 -6 10 -8 11 -9 -64 0 5 2 6 1 7 -1 8 -6 9 -8 10 -9 12 -9 13 -8 14 -6 -64 0 -3 -9 4 -9 -64 -64 2808 95 -16 -9 12 -10 10 -6 9 -7 12 -7 6 -6 9 -4 11 -2 12 2 12 5 11 6 9 6 6 5 4 2 3 -1 3 -64 0 2 12 4 11 5 9 5 6 4 4 2 3 -64 0 2 3 4 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -3 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -4 -6 -5 -64 0 5 1 6 -2 6 -5 5 -7 4 -8 2 -9 -64 -64 2809 59 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 6 10 -6 -7 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2810 79 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 6 10 -6 -7 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 0 -4 18 -4 19 -5 19 -5 18 -4 16 -2 15 2 15 4 16 5 18 -64 -64 2811 91 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 -10 12 -3 12 -64 0 -6 2 1 2 3 3 4 5 5 9 6 11 7 12 8 12 9 11 9 10 8 9 7 10 8 11 -64 0 1 2 3 1 4 -1 5 -6 6 -8 7 -9 -64 0 1 2 2 1 3 -1 4 -6 5 -8 6 -9 8 -9 9 -8 10 -6 -64 0 -10 -9 -3 -9 -64 -64 2812 55 -16 -9 12 -13 12 -5 12 -5 6 -6 -2 -7 -6 -8 -8 -9 -9 -10 -9 -11 -8 -11 -7 -10 -6 -9 -7 -10 -8 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -8 12 10 12 -64 0 3 -9 10 -9 -64 -64 2813 65 -16 -9 12 -12 13 -7 12 -7 -9 -64 0 -6 12 0 -6 -64 0 -7 12 0 -9 -64 0 7 12 0 -9 -64 0 7 12 7 -9 -64 0 8 12 8 -9 -64 0 -10 12 -6 12 -64 0 7 12 11 12 -64 0 -10 -9 -4 -9 -64 0 4 -9 11 -9 -64 -64 2814 59 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 -6 2 6 2 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2815 93 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -1 12 -3 11 -5 9 -6 7 -7 3 -7 0 -6 -4 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -4 7 0 7 3 6 7 5 9 3 11 1 12 -64 -64 2816 47 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 10 12 -64 0 -10 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2817 63 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 12 -5 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 5 7 3 6 2 3 1 -5 1 -64 0 3 12 5 11 6 10 7 8 7 5 6 3 5 2 3 1 -64 0 -9 -9 -2 -9 -64 -64 2818 69 -16 -9 12 -11 10 6 9 7 6 7 12 6 9 4 11 1 12 -1 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 -64 0 -1 12 -3 11 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -3 -8 -1 -9 -64 -64 2819 37 -16 -9 12 -9 10 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -6 12 -7 6 -7 12 8 12 8 6 7 12 -64 0 -3 -9 4 -9 -64 -64 2820 53 -16 -9 12 -10 11 -7 12 0 -4 -64 0 -6 12 1 -4 -64 0 8 12 1 -4 -1 -7 -2 -8 -4 -9 -5 -9 -6 -8 -6 -7 -5 -6 -4 -7 -5 -8 -64 0 -9 12 -3 12 -64 0 4 12 10 12 -64 -64 2821 101 -16 -9 12 -12 13 0 12 0 -9 -64 0 1 12 1 -9 -64 0 -3 12 4 12 -64 0 -2 9 -6 8 -8 6 -9 3 -9 0 -8 -3 -6 -5 -2 -6 3 -6 7 -5 9 -3 10 0 10 3 9 6 7 8 3 9 -2 9 -64 0 -2 9 -5 8 -7 6 -8 3 -8 0 -7 -3 -5 -5 -2 -6 -64 0 3 -6 6 -5 8 -3 9 0 9 3 8 6 6 8 3 9 -64 0 -3 -9 4 -9 -64 -64 2822 47 -16 -9 12 -10 10 -7 12 6 -9 -64 0 -6 12 7 -9 -64 0 7 12 -7 -9 -64 0 -9 12 -3 12 -64 0 3 12 9 12 -64 0 -9 -9 -3 -9 -64 0 3 -9 9 -9 -64 -64 2823 59 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 12 -6 -9 -64 0 6 12 6 -9 -64 0 7 12 7 -9 -64 0 -10 12 -3 12 -64 0 3 12 10 12 -64 0 -10 -9 10 -9 -64 0 9 -9 10 -16 -64 0 10 -9 10 -16 -64 -64 2824 61 -16 -9 12 -12 11 -7 12 -7 1 -6 -1 -3 -2 0 -2 3 -1 5 1 -64 0 -6 12 -6 1 -5 -1 -3 -2 -64 0 5 12 5 -9 -64 0 6 12 6 -9 -64 0 -10 12 -3 12 -64 0 2 12 9 12 -64 0 2 -9 9 -9 -64 -64 2825 65 -16 -9 12 -16 17 -11 12 -11 -9 -64 0 -10 12 -10 -9 -64 0 0 12 0 -9 -64 0 1 12 1 -9 -64 0 11 12 11 -9 -64 0 12 12 12 -9 -64 0 -14 12 -7 12 -64 0 -3 12 4 12 -64 0 8 12 15 12 -64 0 -14 -9 15 -9 -64 -64 2826 77 -16 -9 12 -16 17 -11 12 -11 -9 -64 0 -10 12 -10 -9 -64 0 0 12 0 -9 -64 0 1 12 1 -9 -64 0 11 12 11 -9 -64 0 12 12 12 -9 -64 0 -14 12 -7 12 -64 0 -3 12 4 12 -64 0 8 12 15 12 -64 0 -14 -9 15 -9 -64 0 14 -9 15 -16 -64 0 15 -9 15 -16 -64 -64 2827 67 -16 -9 12 -12 14 -2 12 -2 -9 -64 0 -1 12 -1 -9 -64 0 -9 12 -10 6 -10 12 2 12 -64 0 -1 2 6 2 9 1 10 0 11 -2 11 -5 10 -7 9 -8 6 -9 -5 -9 -64 0 6 2 8 1 9 0 10 -2 10 -5 9 -7 8 -8 6 -9 -64 -64 2828 87 -16 -9 12 -15 15 -10 12 -10 -9 -64 0 -9 12 -9 -9 -64 0 -13 12 -6 12 -64 0 -9 2 -2 2 1 1 2 0 3 -2 3 -5 2 -7 1 -8 -2 -9 -13 -9 -64 0 -2 2 0 1 1 0 2 -2 2 -5 1 -7 0 -8 -2 -9 -64 0 9 12 9 -9 -64 0 10 12 10 -9 -64 0 6 12 13 12 -64 0 6 -9 13 -9 -64 -64 2829 63 -16 -9 12 -10 11 -5 12 -5 -9 -64 0 -4 12 -4 -9 -64 0 -8 12 -1 12 -64 0 -4 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -8 -9 -64 0 3 2 5 1 6 0 7 -2 7 -5 6 -7 5 -8 3 -9 -64 -64 2830 83 -16 -9 12 -10 11 -6 9 -7 12 -7 6 -6 9 -4 11 -1 12 1 12 4 11 6 9 7 7 8 4 8 -1 7 -4 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -4 -6 -5 -64 0 1 12 3 11 5 9 6 7 7 4 7 -1 6 -4 5 -6 3 -8 1 -9 -64 0 -2 2 7 2 -64 -64 2831 123 -16 -9 12 -15 16 -10 12 -10 -9 -64 0 -9 12 -9 -9 -64 0 -13 12 -6 12 -64 0 -13 -9 -6 -9 -64 0 4 12 1 11 -1 9 -2 7 -3 3 -3 0 -2 -4 -1 -6 1 -8 4 -9 6 -9 9 -8 11 -6 12 -4 13 0 13 3 12 7 11 9 9 11 6 12 4 12 -64 0 4 12 2 11 0 9 -1 7 -2 3 -2 0 -1 -4 0 -6 2 -8 4 -9 -64 0 6 -9 8 -8 10 -6 11 -4 12 0 12 3 11 7 10 9 8 11 6 12 -64 0 -9 2 -3 2 -64 -64 2832 95 -16 -9 12 -11 11 5 12 5 -9 -64 0 6 12 6 -9 -64 0 9 12 -3 12 -6 11 -7 10 -8 8 -8 6 -7 4 -6 3 -3 2 5 2 -64 0 -3 12 -5 11 -6 10 -7 8 -7 6 -6 4 -5 3 -3 2 -64 0 0 2 -2 1 -3 0 -6 -7 -7 -8 -8 -8 -9 -7 -64 0 -2 1 -3 -1 -5 -8 -6 -9 -8 -9 -9 -7 -9 -6 -64 0 2 -9 9 -9 -64 -64 2901 83 -16 -9 12 -9 11 -4 3 -4 2 -5 2 -5 3 -4 4 -2 5 2 5 4 4 5 3 6 1 6 -6 7 -8 8 -9 -64 0 5 3 5 -6 6 -8 8 -9 9 -9 -64 0 5 1 4 0 -2 -1 -5 -2 -6 -4 -6 -6 -5 -8 -2 -9 1 -9 3 -8 5 -6 -64 0 -2 -1 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 -64 -64 2902 101 -16 -9 12 -10 10 6 12 5 11 -1 9 -4 7 -6 4 -7 1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 1 5 -1 5 -4 4 -6 2 -7 -1 -64 0 6 12 5 10 3 9 -1 8 -4 6 -6 4 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -3 6 -1 5 2 3 4 1 5 -64 -64 2903 79 -16 -9 12 -10 10 -5 5 -5 -9 -64 0 -4 5 -4 -9 -64 0 -8 5 3 5 6 4 7 2 7 1 6 -1 3 -2 -64 0 3 5 5 4 6 2 6 1 5 -1 3 -2 -64 0 -4 -2 3 -2 6 -3 7 -5 7 -6 6 -8 3 -9 -8 -9 -64 0 3 -2 5 -3 6 -5 6 -6 5 -8 3 -9 -64 -64 2904 33 -16 -9 12 -10 8 -5 5 -5 -9 -64 0 -4 5 -4 -9 -64 0 -8 5 6 5 6 0 5 5 -64 0 -8 -9 -1 -9 -64 -64 2905 49 -16 -9 12 -12 11 -4 5 -4 1 -5 -5 -6 -8 -7 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -7 5 9 5 -64 0 -9 -9 -10 -14 -10 -9 9 -9 9 -14 8 -9 -64 -64 2906 67 -16 -9 12 -10 9 -6 -1 6 -1 6 1 5 3 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 5 -1 5 2 4 4 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 -64 2907 123 -16 -9 12 -13 14 0 5 0 -9 -64 0 1 5 1 -9 -64 0 -3 5 4 5 -64 0 -8 4 -9 3 -10 4 -9 5 -8 5 -7 4 -5 0 -4 -1 -2 -2 3 -2 5 -1 6 0 8 4 9 5 10 5 11 4 10 3 9 4 -64 0 -2 -2 -4 -3 -5 -4 -7 -8 -8 -9 -64 0 -2 -2 -4 -4 -6 -8 -7 -9 -9 -9 -10 -8 -11 -6 -64 0 3 -2 5 -3 6 -4 8 -8 9 -9 -64 0 3 -2 5 -4 7 -8 8 -9 10 -9 11 -8 12 -6 -64 0 -3 -9 4 -9 -64 -64 2908 89 -16 -9 12 -9 9 -5 3 -6 5 -6 1 -5 3 -4 4 -2 5 2 5 5 4 6 2 6 1 5 -1 2 -2 -64 0 2 5 4 4 5 2 5 1 4 -1 2 -2 -64 0 -1 -2 2 -2 5 -3 6 -5 6 -6 5 -8 2 -9 -2 -9 -5 -8 -6 -6 -6 -5 -5 -4 -4 -5 -5 -6 -64 0 2 -2 4 -3 5 -5 5 -6 4 -8 2 -9 -64 -64 2909 59 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -2 5 -64 0 2 5 9 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 0 5 4 -5 -8 -64 -64 2910 79 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -2 5 -64 0 2 5 9 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 0 5 4 -5 -8 -64 0 -3 11 -3 12 -4 12 -4 11 -3 9 -1 8 1 8 3 9 4 11 -64 -64 2911 81 -16 -9 12 -10 10 -5 5 -5 -9 -64 0 -4 5 -4 -9 -64 0 -8 5 -1 5 -64 0 -4 -2 -2 -2 1 -1 2 0 4 4 5 5 6 5 7 4 6 3 5 4 -64 0 -2 -2 1 -3 2 -4 4 -8 5 -9 -64 0 -2 -2 0 -3 1 -4 3 -8 4 -9 6 -9 7 -8 8 -6 -64 0 -8 -9 -1 -9 -64 -64 2912 49 -16 -9 12 -11 11 -4 5 -4 1 -5 -5 -6 -8 -7 -9 -8 -9 -9 -8 -8 -7 -7 -8 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -7 5 9 5 -64 0 2 -9 9 -9 -64 -64 2913 65 -16 -9 12 -11 12 -6 5 -6 -9 -64 0 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 6 5 0 -9 -64 0 6 5 6 -9 -64 0 7 5 7 -9 -64 0 -9 5 -5 5 -64 0 6 5 10 5 -64 0 -9 -9 -3 -9 -64 0 3 -9 10 -9 -64 -64 2914 59 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -2 5 -64 0 2 5 9 5 -64 0 -5 -2 5 -2 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2915 77 -16 -9 12 -10 10 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 1 5 -1 5 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -6 6 -3 6 -1 5 2 3 4 1 5 -64 -64 2916 47 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 9 5 -64 0 -9 -9 -2 -9 -64 0 2 -9 9 -9 -64 -64 2917 77 -16 -9 12 -11 10 -6 5 -6 -16 -64 0 -5 5 -5 -16 -64 0 -5 2 -3 4 -1 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -1 -9 -3 -8 -5 -6 -64 0 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -64 0 -9 5 -5 5 -64 0 -9 -16 -2 -16 -64 -64 2918 61 -16 -9 12 -10 9 5 2 4 1 5 0 6 1 6 2 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 -1 5 -3 4 -5 2 -6 -1 -6 -3 -5 -6 -3 -8 -1 -9 -64 -64 2919 37 -16 -9 12 -9 10 0 5 0 -9 -64 0 1 5 1 -9 -64 0 -5 5 -6 0 -6 5 7 5 7 0 6 5 -64 0 -3 -9 4 -9 -64 -64 2920 49 -16 -9 12 -9 9 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 6 5 0 -9 -2 -13 -4 -15 -6 -16 -7 -16 -8 -15 -7 -14 -6 -15 -64 0 -8 5 -2 5 -64 0 2 5 8 5 -64 -64 2921 109 -16 -9 12 -10 11 0 12 0 -16 -64 0 1 12 1 -16 -64 0 -3 12 1 12 -64 0 0 2 -1 4 -2 5 -4 5 -6 4 -7 1 -7 -5 -6 -8 -4 -9 -2 -9 -1 -8 0 -6 -64 0 -4 5 -5 4 -6 1 -6 -5 -5 -8 -4 -9 -64 0 5 5 6 4 7 1 7 -5 6 -8 5 -9 -64 0 1 2 2 4 3 5 5 5 7 4 8 1 8 -5 7 -8 5 -9 3 -9 2 -8 1 -6 -64 0 -3 -16 4 -16 -64 -64 2922 47 -16 -9 12 -10 10 -6 5 5 -9 -64 0 -5 5 6 -9 -64 0 6 5 -6 -9 -64 0 -8 5 -2 5 -64 0 2 5 8 5 -64 0 -8 -9 -2 -9 -64 0 2 -9 8 -9 -64 -64 2923 51 -16 -9 12 -11 11 -6 5 -6 -9 -64 0 -5 5 -5 -9 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -2 5 -64 0 2 5 9 5 -64 0 -9 -9 9 -9 9 -14 8 -9 -64 -64 2924 61 -16 -9 12 -11 11 -6 5 -6 -2 -5 -4 -2 -5 0 -5 3 -4 5 -2 -64 0 -5 5 -5 -2 -4 -4 -2 -5 -64 0 5 5 5 -9 -64 0 6 5 6 -9 -64 0 -9 5 -2 5 -64 0 2 5 9 5 -64 0 2 -9 9 -9 -64 -64 2925 65 -16 -9 12 -15 16 -10 5 -10 -9 -64 0 -9 5 -9 -9 -64 0 0 5 0 -9 -64 0 1 5 1 -9 -64 0 10 5 10 -9 -64 0 11 5 11 -9 -64 0 -13 5 -6 5 -64 0 -3 5 4 5 -64 0 7 5 14 5 -64 0 -13 -9 14 -9 -64 -64 2926 69 -16 -9 12 -15 16 -10 5 -10 -9 -64 0 -9 5 -9 -9 -64 0 0 5 0 -9 -64 0 1 5 1 -9 -64 0 10 5 10 -9 -64 0 11 5 11 -9 -64 0 -13 5 -6 5 -64 0 -3 5 4 5 -64 0 7 5 14 5 -64 0 -13 -9 14 -9 14 -14 13 -9 -64 -64 2927 59 -16 -9 12 -10 11 -1 5 -1 -9 -64 0 0 5 0 -9 -64 0 -6 5 -7 0 -7 5 3 5 -64 0 0 -2 4 -2 7 -3 8 -5 8 -6 7 -8 4 -9 -4 -9 -64 0 4 -2 6 -3 7 -5 7 -6 6 -8 4 -9 -64 -64 2928 79 -16 -9 12 -13 13 -8 5 -8 -9 -64 0 -7 5 -7 -9 -64 0 -11 5 -4 5 -64 0 -7 -2 -3 -2 0 -3 1 -5 1 -6 0 -8 -3 -9 -11 -9 -64 0 -3 -2 -1 -3 0 -5 0 -6 -1 -8 -3 -9 -64 0 7 5 7 -9 -64 0 8 5 8 -9 -64 0 4 5 11 5 -64 0 4 -9 11 -9 -64 -64 2929 55 -16 -9 12 -8 9 -3 5 -3 -9 -64 0 -2 5 -2 -9 -64 0 -6 5 1 5 -64 0 -2 -2 2 -2 5 -3 6 -5 6 -6 5 -8 2 -9 -6 -9 -64 0 2 -2 4 -3 5 -5 5 -6 4 -8 2 -9 -64 -64 2930 73 -16 -9 12 -9 10 -5 3 -6 5 -6 1 -5 3 -4 4 -2 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -4 -8 -6 -6 -6 -5 -5 -4 -4 -5 -5 -6 -64 0 1 5 3 4 5 2 6 -1 6 -3 5 -6 3 -8 1 -9 -64 0 0 -2 6 -2 -64 -64 2931 107 -16 -9 12 -14 15 -9 5 -9 -9 -64 0 -8 5 -8 -9 -64 0 -12 5 -5 5 -64 0 -12 -9 -5 -9 -64 0 4 5 1 4 -1 2 -2 -1 -2 -3 -1 -6 1 -8 4 -9 6 -9 9 -8 11 -6 12 -3 12 -1 11 2 9 4 6 5 4 5 -64 0 4 5 2 4 0 2 -1 -1 -1 -3 0 -6 2 -8 4 -9 -64 0 6 -9 8 -8 10 -6 11 -3 11 -1 10 2 8 4 6 5 -64 0 -8 -2 -2 -2 -64 -64 2932 85 -16 -9 12 -11 10 4 5 4 -9 -64 0 5 5 5 -9 -64 0 8 5 -3 5 -6 4 -7 2 -7 1 -6 -1 -3 -2 4 -2 -64 0 -3 5 -5 4 -6 2 -6 1 -5 -1 -3 -2 -64 0 2 -2 -1 -3 -2 -4 -4 -8 -5 -9 -64 0 2 -2 0 -3 -1 -4 -3 -8 -4 -9 -6 -9 -7 -8 -8 -6 -64 0 1 -9 8 -9 -64 -64 3001 77 -16 -9 12 -10 10 0 12 -7 -8 -64 0 -1 9 5 -9 -64 0 0 9 6 -9 -64 0 0 12 7 -9 -64 0 -5 -3 4 -3 -64 0 -9 -9 -3 -9 -64 0 2 -9 9 -9 -64 0 -7 -8 -8 -9 -64 0 -7 -8 -5 -9 -64 0 5 -8 3 -9 -64 0 5 -7 4 -9 -64 0 6 -7 8 -9 -64 -64 3002 161 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -64 0 6 10 7 8 7 6 6 4 -64 0 3 12 5 11 6 9 6 5 5 3 3 2 -64 0 -4 2 3 2 6 1 7 0 8 -2 8 -5 7 -7 6 -8 3 -9 -9 -9 -64 0 6 0 7 -2 7 -5 6 -7 -64 0 3 2 5 1 6 -1 6 -6 5 -8 3 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 -64 3003 79 -16 -9 12 -11 10 6 9 7 12 7 6 6 9 4 11 2 12 -1 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -1 -9 2 -9 4 -8 6 -6 7 -4 -64 0 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -64 0 -1 12 -3 11 -5 8 -6 4 -6 -1 -5 -5 -3 -8 -1 -9 -64 -64 3004 129 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 1 12 4 11 6 9 7 7 8 4 8 -1 7 -4 6 -6 4 -8 1 -9 -9 -9 -64 0 5 9 6 7 7 4 7 -1 6 -4 5 -6 -64 0 1 12 3 11 5 8 6 4 6 -1 5 -5 3 -8 1 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 -64 3005 171 -16 -9 12 -11 10 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 7 12 7 6 -64 0 -4 2 2 2 -64 0 2 6 2 -2 -64 0 -9 -9 7 -9 7 -3 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 2 12 7 11 -64 0 4 12 7 10 -64 0 5 12 7 9 -64 0 6 12 7 6 -64 0 2 6 1 2 2 -2 -64 0 2 4 0 2 2 0 -64 0 2 3 -2 2 2 1 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 0 2 -9 7 -8 -64 0 4 -9 7 -7 -64 0 5 -9 7 -6 -64 0 6 -9 7 -3 -64 -64 3006 145 -16 -9 12 -11 9 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 7 12 7 6 -64 0 -4 2 2 2 -64 0 2 6 2 -2 -64 0 -9 -9 -1 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 2 12 7 11 -64 0 4 12 7 10 -64 0 5 12 7 9 -64 0 6 12 7 6 -64 0 2 6 1 2 2 -2 -64 0 2 4 0 2 2 0 -64 0 2 3 -2 2 2 1 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 -64 3007 125 -16 -9 12 -11 12 6 9 7 12 7 6 6 9 4 11 2 12 -1 12 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -1 -9 2 -9 4 -8 6 -8 7 -9 7 -1 -64 0 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -64 0 -1 12 -3 11 -5 8 -6 4 -6 -1 -5 -5 -3 -8 -1 -9 -64 0 6 -2 6 -7 -64 0 5 -1 5 -7 4 -8 -64 0 2 -1 10 -1 -64 0 3 -1 5 -2 -64 0 4 -1 5 -3 -64 0 8 -1 7 -3 -64 0 9 -1 7 -2 -64 -64 3008 167 -16 -9 12 -12 12 -7 12 -7 -9 -64 0 -6 11 -6 -8 -64 0 -5 12 -5 -9 -64 0 5 12 5 -9 -64 0 6 11 6 -8 -64 0 7 12 7 -9 -64 0 -10 12 -2 12 -64 0 2 12 10 12 -64 0 -5 2 5 2 -64 0 -10 -9 -2 -9 -64 0 2 -9 10 -9 -64 0 -9 12 -7 11 -64 0 -8 12 -7 10 -64 0 -4 12 -5 10 -64 0 -3 12 -5 11 -64 0 3 12 5 11 -64 0 4 12 5 10 -64 0 8 12 7 10 -64 0 9 12 7 11 -64 0 -7 -8 -9 -9 -64 0 -7 -7 -8 -9 -64 0 -5 -7 -4 -9 -64 0 -5 -8 -3 -9 -64 0 5 -8 3 -9 -64 0 5 -7 4 -9 -64 0 7 -7 8 -9 -64 0 7 -8 9 -9 -64 -64 3009 83 -16 -9 12 -6 6 -1 12 -1 -9 -64 0 0 11 0 -8 -64 0 1 12 1 -9 -64 0 -4 12 4 12 -64 0 -4 -9 4 -9 -64 0 -3 12 -1 11 -64 0 -2 12 -1 10 -64 0 2 12 1 10 -64 0 3 12 1 11 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3010 95 -16 -9 12 -8 8 1 12 1 -5 0 -8 -1 -9 -64 0 2 11 2 -5 1 -8 -64 0 3 12 3 -5 2 -8 -1 -9 -3 -9 -5 -8 -6 -6 -6 -4 -5 -3 -4 -3 -3 -4 -3 -5 -4 -6 -5 -6 -64 0 -5 -4 -5 -5 -4 -5 -4 -4 -5 -4 -64 0 -2 12 6 12 -64 0 -1 12 1 11 -64 0 0 12 1 10 -64 0 4 12 3 10 -64 0 5 12 3 11 -64 -64 3011 143 -16 -9 12 -12 10 -7 12 -7 -9 -64 0 -6 11 -6 -8 -64 0 -5 12 -5 -9 -64 0 6 11 -5 0 -64 0 -2 2 5 -9 -64 0 -1 2 6 -9 -64 0 -1 4 7 -9 -64 0 -10 12 -2 12 -64 0 3 12 9 12 -64 0 -10 -9 -2 -9 -64 0 2 -9 9 -9 -64 0 -9 12 -7 11 -64 0 -8 12 -7 10 -64 0 -4 12 -5 10 -64 0 -3 12 -5 11 -64 0 5 12 6 11 -64 0 8 12 6 11 -64 0 -7 -8 -9 -9 -64 0 -7 -7 -8 -9 -64 0 -5 -7 -4 -9 -64 0 -5 -8 -3 -9 -64 0 5 -7 3 -9 -64 0 5 -7 8 -9 -64 -64 3012 109 -16 -9 12 -9 9 -4 12 -4 -9 -64 0 -3 11 -3 -8 -64 0 -2 12 -2 -9 -64 0 -7 12 1 12 -64 0 -7 -9 8 -9 8 -3 -64 0 -6 12 -4 11 -64 0 -5 12 -4 10 -64 0 -1 12 -2 10 -64 0 0 12 -2 11 -64 0 -4 -8 -6 -9 -64 0 -4 -7 -5 -9 -64 0 -2 -7 -1 -9 -64 0 -2 -8 0 -9 -64 0 3 -9 8 -8 -64 0 5 -9 8 -7 -64 0 6 -9 8 -6 -64 0 7 -9 8 -3 -64 -64 3013 131 -16 -9 12 -13 13 -8 12 -8 -8 -64 0 -8 12 -1 -9 -64 0 -7 12 -1 -6 -64 0 -6 12 0 -6 -64 0 6 12 -1 -9 -64 0 6 12 6 -9 -64 0 7 11 7 -8 -64 0 8 12 8 -9 -64 0 -11 12 -6 12 -64 0 6 12 11 12 -64 0 -11 -9 -5 -9 -64 0 3 -9 11 -9 -64 0 -10 12 -8 11 -64 0 9 12 8 10 -64 0 10 12 8 11 -64 0 -8 -8 -10 -9 -64 0 -8 -8 -6 -9 -64 0 6 -8 4 -9 -64 0 6 -7 5 -9 -64 0 8 -7 9 -9 -64 0 8 -8 10 -9 -64 -64 3014 83 -16 -9 12 -12 12 -7 12 -7 -8 -64 0 -7 12 7 -9 -64 0 -6 12 6 -6 -64 0 -5 12 7 -6 -64 0 7 11 7 -9 -64 0 -10 12 -5 12 -64 0 4 12 10 12 -64 0 -10 -9 -4 -9 -64 0 -9 12 -7 11 -64 0 5 12 7 11 -64 0 9 12 7 11 -64 0 -7 -8 -9 -9 -64 0 -7 -8 -5 -9 -64 -64 3015 113 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -64 0 5 -6 6 -4 7 -1 7 4 6 7 5 9 -64 0 -1 12 -3 11 -5 8 -6 4 -6 -1 -5 -5 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -5 6 -1 6 4 5 8 3 11 1 12 -64 -64 3016 123 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 5 7 3 6 2 3 1 -4 1 -64 0 6 10 7 8 7 5 6 3 -64 0 3 12 5 11 6 9 6 4 5 2 3 1 -64 0 -9 -9 -1 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 -64 3017 159 -16 -9 12 -11 11 -1 12 -4 11 -6 9 -7 7 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -4 8 0 8 3 7 7 6 9 4 11 1 12 -1 12 -64 0 -5 9 -6 7 -7 4 -7 -1 -6 -4 -5 -6 -64 0 5 -6 6 -4 7 -1 7 4 6 7 5 9 -64 0 -1 12 -3 11 -5 8 -6 4 -6 -1 -5 -5 -3 -8 -1 -9 -64 0 1 -9 3 -8 5 -5 6 -1 6 4 5 8 3 11 1 12 -64 0 -4 -6 -3 -4 -1 -3 0 -3 2 -4 3 -6 4 -12 5 -14 7 -14 8 -12 8 -10 -64 0 4 -10 5 -12 6 -13 7 -13 -64 0 3 -6 5 -11 6 -12 7 -12 8 -11 -64 -64 3018 165 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -4 12 -4 -9 -64 0 -9 12 3 12 6 11 7 10 8 8 8 6 7 4 6 3 3 2 -4 2 -64 0 6 10 7 8 7 6 6 4 -64 0 3 12 5 11 6 9 6 5 5 3 3 2 -64 0 0 2 2 1 3 -1 5 -7 6 -9 8 -9 9 -7 9 -5 -64 0 5 -5 6 -7 7 -8 8 -8 -64 0 2 1 3 0 6 -6 7 -7 8 -7 9 -6 -64 0 -9 -9 -1 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -3 12 -4 10 -64 0 -2 12 -4 11 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 -64 3019 93 -16 -9 12 -10 10 6 9 7 12 7 6 6 9 4 11 1 12 -2 12 -5 11 -7 9 -7 6 -6 4 -3 2 3 0 5 -1 6 -3 6 -6 5 -8 -64 0 -6 6 -5 4 -3 3 3 1 5 0 6 -2 -64 0 -5 11 -6 9 -6 7 -5 5 -3 4 3 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -1 -9 -4 -8 -6 -6 -7 -3 -7 -9 -6 -6 -64 -64 3020 119 -16 -9 12 -10 10 -8 12 -8 6 -64 0 -1 12 -1 -9 -64 0 0 11 0 -8 -64 0 1 12 1 -9 -64 0 8 12 8 6 -64 0 -8 12 8 12 -64 0 -4 -9 4 -9 -64 0 -7 12 -8 6 -64 0 -6 12 -8 9 -64 0 -5 12 -8 10 -64 0 -3 12 -8 11 -64 0 3 12 8 11 -64 0 5 12 8 10 -64 0 6 12 8 9 -64 0 7 12 8 6 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3021 95 -16 -9 12 -12 12 -7 12 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 11 -64 0 -6 11 -6 -4 -5 -6 -64 0 -5 12 -5 -4 -4 -7 -3 -8 -1 -9 -64 0 -10 12 -2 12 -64 0 4 12 10 12 -64 0 -9 12 -7 11 -64 0 -8 12 -7 10 -64 0 -4 12 -5 10 -64 0 -3 12 -5 11 -64 0 5 12 7 11 -64 0 9 12 7 11 -64 -64 3022 73 -16 -9 12 -10 10 -7 12 0 -9 -64 0 -6 12 0 -6 0 -9 -64 0 -5 12 1 -6 -64 0 7 11 0 -9 -64 0 -9 12 -2 12 -64 0 3 12 9 12 -64 0 -8 12 -6 10 -64 0 -4 12 -5 10 -64 0 -3 12 -5 11 -64 0 5 12 7 11 -64 0 8 12 7 11 -64 -64 3023 115 -16 -9 12 -12 12 -8 12 -4 -9 -64 0 -7 12 -4 -4 -4 -9 -64 0 -6 12 -3 -4 -64 0 0 12 -3 -4 -4 -9 -64 0 0 12 4 -9 -64 0 1 12 4 -4 4 -9 -64 0 2 12 5 -4 -64 0 8 11 5 -4 4 -9 -64 0 -11 12 -3 12 -64 0 0 12 2 12 -64 0 5 12 11 12 -64 0 -10 12 -7 11 -64 0 -9 12 -7 10 -64 0 -5 12 -6 10 -64 0 -4 12 -6 11 -64 0 6 12 8 11 -64 0 10 12 8 11 -64 -64 3024 113 -16 -9 12 -10 10 -7 12 5 -9 -64 0 -6 12 6 -9 -64 0 -5 12 7 -9 -64 0 6 11 -6 -8 -64 0 -9 12 -2 12 -64 0 3 12 9 12 -64 0 -9 -9 -3 -9 -64 0 2 -9 9 -9 -64 0 -8 12 -5 10 -64 0 -4 12 -5 10 -64 0 -3 12 -5 11 -64 0 4 12 6 11 -64 0 8 12 6 11 -64 0 -6 -8 -8 -9 -64 0 -6 -8 -4 -9 -64 0 5 -8 3 -9 -64 0 5 -7 4 -9 -64 0 5 -7 8 -9 -64 -64 3025 101 -16 -9 12 -11 11 -8 12 -1 1 -1 -9 -64 0 -7 12 0 1 0 -8 -64 0 -6 12 1 1 1 -9 -64 0 7 11 1 1 -64 0 -10 12 -3 12 -64 0 4 12 10 12 -64 0 -4 -9 4 -9 -64 0 -9 12 -7 11 -64 0 -4 12 -6 11 -64 0 5 12 7 11 -64 0 9 12 7 11 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3026 87 -16 -9 12 -10 10 7 12 -7 12 -7 6 -64 0 5 12 -7 -9 -64 0 6 12 -6 -9 -64 0 7 12 -5 -9 -64 0 -7 -9 7 -9 7 -3 -64 0 -6 12 -7 6 -64 0 -5 12 -7 9 -64 0 -4 12 -7 10 -64 0 -2 12 -7 11 -64 0 2 -9 7 -8 -64 0 4 -9 7 -7 -64 0 5 -9 7 -6 -64 0 6 -9 7 -3 -64 -64 3051 81 -16 -9 12 -10 10 3 12 -9 -8 -64 0 1 8 2 -9 -64 0 2 10 3 -8 -64 0 3 12 3 10 4 -7 4 -9 -64 0 -6 -3 2 -3 -64 0 -12 -9 -6 -9 -64 0 -1 -9 6 -9 -64 0 -9 -8 -11 -9 -64 0 -9 -8 -7 -9 -64 0 2 -8 0 -9 -64 0 2 -7 1 -9 -64 0 4 -7 5 -9 -64 -64 3052 161 -16 -9 12 -12 12 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 -6 12 5 12 8 11 9 9 9 7 8 4 7 3 4 2 -64 0 7 11 8 9 8 7 7 4 6 3 -64 0 5 12 6 11 7 9 7 7 6 4 4 2 -64 0 -4 2 4 2 6 1 7 -1 7 -3 6 -6 4 -8 0 -9 -12 -9 -64 0 5 1 6 -1 6 -3 5 -6 3 -8 -64 0 4 2 5 0 5 -3 4 -6 2 -8 0 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 -64 3053 87 -16 -9 12 -10 11 8 10 9 10 10 12 9 6 9 8 8 10 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -2 -9 1 -9 3 -8 5 -6 6 -4 -64 0 -1 10 -3 8 -4 6 -5 3 -6 -1 -6 -5 -5 -7 -64 0 2 12 0 11 -2 8 -3 6 -4 3 -5 -1 -5 -6 -4 -8 -2 -9 -64 -64 3054 131 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 -6 12 3 12 6 11 7 10 8 7 8 3 7 -1 5 -5 3 -7 1 -8 -3 -9 -12 -9 -64 0 5 11 6 10 7 7 7 3 6 -1 4 -5 2 -7 -64 0 3 12 5 10 6 7 6 3 5 -1 3 -5 0 -8 -3 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 -64 3055 165 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 3 6 1 -2 -64 0 -6 12 9 12 8 6 -64 0 -4 2 2 2 -64 0 -12 -9 3 -9 5 -4 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 5 12 8 11 -64 0 6 12 8 10 -64 0 7 12 8 9 -64 0 8 12 8 6 -64 0 3 6 1 2 1 -2 -64 0 2 4 0 2 1 0 -64 0 2 3 -1 2 1 1 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 0 -2 -9 3 -8 -64 0 0 -9 3 -7 -64 0 3 -7 5 -4 -64 -64 3056 145 -16 -9 12 -12 10 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 3 6 1 -2 -64 0 -6 12 9 12 8 6 -64 0 -4 2 2 2 -64 0 -12 -9 -4 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 5 12 8 11 -64 0 6 12 8 10 -64 0 7 12 8 9 -64 0 8 12 8 6 -64 0 3 6 1 2 1 -2 -64 0 2 4 0 2 1 0 -64 0 2 3 -1 2 1 1 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 -64 3057 135 -16 -9 12 -10 12 8 10 9 10 10 12 9 6 9 8 8 10 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -2 -9 0 -9 3 -8 5 -6 7 -2 -64 0 -1 10 -3 8 -4 6 -5 3 -6 -1 -6 -5 -5 -7 -64 0 4 -6 5 -5 6 -2 -64 0 2 12 0 11 -2 8 -3 6 -4 3 -5 -1 -5 -6 -4 -8 -2 -9 -64 0 0 -9 2 -8 4 -5 5 -2 -64 0 2 -2 10 -2 -64 0 3 -2 5 -3 -64 0 4 -2 5 -5 -64 0 8 -2 6 -4 -64 0 9 -2 6 -3 -64 -64 3058 167 -16 -9 12 -13 13 -4 12 -10 -9 -64 0 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 8 12 2 -9 -64 0 9 12 3 -9 -64 0 10 12 4 -9 -64 0 -7 12 1 12 -64 0 5 12 13 12 -64 0 -6 2 6 2 -64 0 -13 -9 -5 -9 -64 0 -1 -9 7 -9 -64 0 -6 12 -3 11 -64 0 -5 12 -4 10 -64 0 -1 12 -3 10 -64 0 0 12 -3 11 -64 0 6 12 9 11 -64 0 7 12 8 10 -64 0 11 12 9 10 -64 0 12 12 9 11 -64 0 -9 -8 -12 -9 -64 0 -9 -7 -11 -9 -64 0 -8 -7 -7 -9 -64 0 -9 -8 -6 -9 -64 0 3 -8 0 -9 -64 0 3 -7 1 -9 -64 0 4 -7 5 -9 -64 0 3 -8 6 -9 -64 -64 3059 83 -16 -9 12 -7 7 2 12 -4 -9 -64 0 3 12 -3 -9 -64 0 4 12 -2 -9 -64 0 -1 12 7 12 -64 0 -7 -9 1 -9 -64 0 0 12 3 11 -64 0 1 12 2 10 -64 0 5 12 3 10 -64 0 6 12 3 11 -64 0 -3 -8 -6 -9 -64 0 -3 -7 -5 -9 -64 0 -2 -7 -1 -9 -64 0 -3 -8 0 -9 -64 -64 3060 99 -16 -9 12 -9 10 5 12 0 -5 -1 -7 -3 -9 -64 0 6 12 2 -1 1 -4 0 -6 -64 0 7 12 3 -1 1 -6 -1 -8 -3 -9 -5 -9 -7 -8 -8 -6 -8 -4 -7 -3 -6 -3 -5 -4 -5 -5 -6 -6 -7 -6 -64 0 -7 -4 -7 -5 -6 -5 -6 -4 -7 -4 -64 0 2 12 10 12 -64 0 3 12 6 11 -64 0 4 12 5 10 -64 0 8 12 6 10 -64 0 9 12 6 11 -64 -64 3061 149 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 10 11 -5 0 -64 0 -1 3 3 -9 -64 0 0 3 4 -9 -64 0 1 4 5 -8 -64 0 -6 12 2 12 -64 0 7 12 13 12 -64 0 -12 -9 -4 -9 -64 0 0 -9 7 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 8 12 10 11 -64 0 12 12 10 11 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 0 3 -8 1 -9 -64 0 3 -7 2 -9 -64 0 4 -7 6 -9 -64 -64 3062 103 -16 -9 12 -10 10 -1 12 -7 -9 -64 0 0 12 -6 -9 -64 0 1 12 -5 -9 -64 0 -4 12 4 12 -64 0 -10 -9 5 -9 7 -3 -64 0 -3 12 0 11 -64 0 -2 12 -1 10 -64 0 2 12 0 10 -64 0 3 12 0 11 -64 0 -6 -8 -9 -9 -64 0 -6 -7 -8 -9 -64 0 -5 -7 -4 -9 -64 0 -6 -8 -3 -9 -64 0 0 -9 5 -8 -64 0 2 -9 6 -6 -64 0 4 -9 7 -3 -64 -64 3063 141 -16 -9 12 -14 14 -5 12 -11 -8 -64 0 -5 11 -4 -7 -4 -9 -64 0 -4 12 -3 -7 -64 0 -3 12 -2 -6 -64 0 9 12 -2 -6 -4 -9 -64 0 9 12 3 -9 -64 0 10 12 4 -9 -64 0 11 12 5 -9 -64 0 -8 12 -3 12 -64 0 9 12 14 12 -64 0 -14 -9 -8 -9 -64 0 0 -9 8 -9 -64 0 -7 12 -5 11 -64 0 -6 12 -5 10 -64 0 12 12 10 10 -64 0 13 12 10 11 -64 0 -11 -8 -13 -9 -64 0 -11 -8 -9 -9 -64 0 4 -8 1 -9 -64 0 4 -7 2 -9 -64 0 5 -7 6 -9 -64 0 4 -8 7 -9 -64 -64 3064 91 -16 -9 12 -12 13 -3 12 -9 -8 -64 0 -3 12 4 -9 -64 0 -2 12 4 -6 -64 0 -1 12 5 -6 -64 0 10 11 5 -6 4 -9 -64 0 -6 12 -1 12 -64 0 7 12 13 12 -64 0 -12 -9 -6 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -2 10 -64 0 8 12 10 11 -64 0 12 12 10 11 -64 0 -9 -8 -11 -9 -64 0 -9 -8 -7 -9 -64 -64 3065 117 -16 -9 12 -11 11 1 12 -2 11 -4 9 -6 6 -7 3 -8 -1 -8 -4 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 1 12 -64 0 -3 9 -5 6 -6 3 -7 -1 -7 -5 -6 -7 -64 0 3 -6 5 -3 6 0 7 4 7 8 6 10 -64 0 1 12 -1 11 -3 8 -4 6 -5 3 -6 -1 -6 -6 -5 -8 -4 -9 -64 0 -1 -9 1 -8 3 -5 4 -3 5 0 6 4 6 9 5 11 4 12 -64 -64 3066 125 -16 -9 12 -12 11 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 -6 12 6 12 9 11 10 9 10 7 9 4 7 2 3 1 -5 1 -64 0 8 11 9 9 9 7 8 4 6 2 -64 0 6 12 7 11 8 9 8 7 7 4 5 2 3 1 -64 0 -12 -9 -4 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 -64 3067 161 -16 -9 12 -11 11 1 12 -2 11 -4 9 -6 6 -7 3 -8 -1 -8 -4 -7 -7 -6 -8 -4 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 1 12 -64 0 -3 9 -5 6 -6 3 -7 -1 -7 -5 -6 -7 -64 0 3 -6 5 -3 6 0 7 4 7 8 6 10 -64 0 1 12 -1 11 -3 8 -4 6 -5 3 -6 -1 -6 -6 -5 -8 -4 -9 -64 0 -1 -9 1 -8 3 -5 4 -3 5 0 6 4 6 9 5 11 4 12 -64 0 -6 -6 -5 -4 -3 -3 -2 -3 0 -4 1 -6 2 -11 3 -12 4 -12 5 -11 -64 0 2 -12 3 -13 4 -13 -64 0 1 -6 1 -13 2 -14 4 -14 5 -11 5 -10 -64 -64 3068 161 -16 -9 12 -12 12 -3 12 -9 -9 -64 0 -2 12 -8 -9 -64 0 -1 12 -7 -9 -64 0 -6 12 5 12 8 11 9 9 9 7 8 4 7 3 4 2 -4 2 -64 0 7 11 8 9 8 7 7 4 6 3 -64 0 5 12 6 11 7 9 7 7 6 4 4 2 -64 0 0 2 2 1 3 0 5 -6 6 -7 7 -7 8 -6 -64 0 5 -7 6 -8 7 -8 -64 0 3 0 4 -8 5 -9 7 -9 8 -6 8 -5 -64 0 -12 -9 -4 -9 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 0 0 12 -2 10 -64 0 1 12 -2 11 -64 0 -8 -8 -11 -9 -64 0 -8 -7 -10 -9 -64 0 -7 -7 -6 -9 -64 0 -8 -8 -5 -9 -64 -64 3069 93 -16 -9 12 -11 12 8 10 9 10 10 12 9 6 9 8 8 10 7 11 4 12 0 12 -3 11 -5 9 -5 6 -4 4 -2 2 4 -1 5 -3 5 -6 4 -8 -64 0 -4 6 -3 4 4 0 5 -2 -64 0 -3 11 -4 9 -4 7 -3 5 3 2 5 0 6 -2 6 -5 5 -7 4 -8 1 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -3 -9 -9 -8 -7 -7 -7 -64 -64 3070 113 -16 -9 12 -11 11 2 12 -4 -9 -64 0 3 12 -3 -9 -64 0 4 12 -2 -9 -64 0 -5 12 -7 6 -64 0 11 12 10 6 -64 0 -5 12 11 12 -64 0 -7 -9 1 -9 -64 0 -4 12 -7 6 -64 0 -2 12 -6 9 -64 0 0 12 -5 11 -64 0 7 12 10 11 -64 0 8 12 10 10 -64 0 9 12 10 9 -64 0 10 12 10 6 -64 0 -3 -8 -6 -9 -64 0 -3 -7 -5 -9 -64 0 -2 -7 -1 -9 -64 0 -3 -8 0 -9 -64 -64 3071 101 -16 -9 12 -12 13 -4 12 -7 1 -8 -3 -8 -6 -7 -8 -4 -9 0 -9 3 -8 5 -6 6 -3 10 11 -64 0 -3 12 -6 1 -7 -3 -7 -7 -6 -8 -64 0 -2 12 -5 1 -6 -3 -6 -7 -4 -9 -64 0 -7 12 1 12 -64 0 7 12 13 12 -64 0 -6 12 -3 11 -64 0 -5 12 -4 10 -64 0 -1 12 -3 10 -64 0 0 12 -3 11 -64 0 8 12 10 11 -64 0 12 12 10 11 -64 -64 3072 75 -16 -9 12 -10 10 -4 12 -4 10 -3 -7 -3 -9 -64 0 -3 11 -2 -6 -64 0 -2 12 -1 -5 -64 0 9 11 -3 -9 -64 0 -6 12 1 12 -64 0 6 12 12 12 -64 0 -5 12 -4 10 -64 0 -1 12 -2 10 -64 0 0 12 -3 11 -64 0 7 12 9 11 -64 0 11 12 9 11 -64 -64 3073 119 -16 -9 12 -13 13 -5 12 -5 10 -7 -7 -7 -9 -64 0 -4 11 -6 -6 -64 0 -3 12 -5 -5 -64 0 3 12 -5 -5 -7 -9 -64 0 3 12 3 10 1 -7 1 -9 -64 0 4 11 2 -6 -64 0 5 12 3 -5 -64 0 11 11 3 -5 1 -9 -64 0 -8 12 0 12 -64 0 3 12 5 12 -64 0 8 12 14 12 -64 0 -7 12 -4 11 -64 0 -6 12 -5 10 -64 0 -2 12 -4 9 -64 0 -1 12 -4 11 -64 0 9 12 11 11 -64 0 13 12 11 11 -64 -64 3074 113 -16 -9 12 -11 11 -4 12 2 -9 -64 0 -3 12 3 -9 -64 0 -2 12 4 -9 -64 0 9 11 -9 -8 -64 0 -6 12 1 12 -64 0 6 12 12 12 -64 0 -12 -9 -6 -9 -64 0 -1 -9 6 -9 -64 0 -5 12 -3 10 -64 0 -1 12 -2 10 -64 0 0 12 -2 11 -64 0 7 12 9 11 -64 0 11 12 9 11 -64 0 -9 -8 -11 -9 -64 0 -9 -8 -7 -9 -64 0 2 -8 0 -9 -64 0 2 -7 1 -9 -64 0 3 -7 5 -9 -64 -64 3075 107 -16 -9 12 -11 11 -5 12 -1 2 -4 -9 -64 0 -4 12 0 2 -3 -9 -64 0 -3 12 1 2 -2 -9 -64 0 10 11 1 2 -64 0 -7 12 0 12 -64 0 7 12 13 12 -64 0 -7 -9 1 -9 -64 0 -6 12 -4 11 -64 0 -2 12 -3 10 -64 0 -1 12 -4 11 -64 0 8 12 10 11 -64 0 12 12 10 11 -64 0 -3 -8 -6 -9 -64 0 -3 -7 -5 -9 -64 0 -2 -7 -1 -9 -64 0 -3 -8 0 -9 -64 -64 3076 75 -16 -9 12 -11 11 8 12 -10 -9 -64 0 9 12 -9 -9 -64 0 10 12 -8 -9 -64 0 10 12 -4 12 -6 6 -64 0 -10 -9 4 -9 6 -3 -64 0 -3 12 -6 6 -64 0 -2 12 -5 9 -64 0 0 12 -4 11 -64 0 0 -9 4 -8 -64 0 2 -9 5 -6 -64 0 3 -9 6 -3 -64 -64 3101 113 -16 -9 12 -9 11 -4 2 -4 3 -3 3 -3 1 -5 1 -5 3 -4 4 -2 5 2 5 4 4 5 3 6 1 6 -6 7 -8 8 -9 -64 0 4 3 5 1 5 -6 6 -8 -64 0 2 5 3 4 4 2 4 -6 5 -8 8 -9 9 -9 -64 0 4 0 3 -1 -2 -2 -5 -3 -6 -5 -6 -6 -5 -8 -2 -9 1 -9 3 -8 4 -6 -64 0 -4 -3 -5 -5 -5 -6 -4 -8 -64 0 3 -1 -1 -2 -3 -3 -4 -5 -4 -6 -3 -8 -2 -9 -64 -64 3102 99 -16 -9 12 -11 10 -6 12 -6 -9 -5 -8 -3 -8 -64 0 -5 11 -5 -7 -64 0 -9 12 -4 12 -4 -8 -64 0 -4 2 -3 4 -1 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -1 -9 -3 -8 -4 -6 -64 0 5 2 6 0 6 -4 5 -6 -64 0 1 5 3 4 4 3 5 0 5 -4 4 -7 3 -8 1 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 -64 3103 73 -16 -9 12 -10 9 5 1 5 2 4 2 4 0 6 0 6 2 4 4 2 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 -5 2 -6 0 -6 -4 -5 -6 -64 0 -1 5 -3 4 -4 3 -5 0 -5 -4 -4 -7 -3 -8 -1 -9 -64 -64 3104 109 -16 -9 12 -10 11 4 12 4 -9 9 -9 -64 0 5 11 5 -8 -64 0 1 12 6 12 6 -9 -64 0 4 2 3 4 1 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 3 -8 4 -6 -64 0 -5 2 -6 0 -6 -4 -5 -6 -64 0 -1 5 -3 4 -4 3 -5 0 -5 -4 -4 -7 -3 -8 -1 -9 -64 0 2 12 4 11 -64 0 3 12 4 10 -64 0 6 -7 7 -9 -64 0 6 -8 8 -9 -64 -64 3105 87 -16 -9 12 -10 9 -5 -1 6 -1 6 1 5 3 4 4 1 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 -64 0 5 0 5 1 4 3 -64 0 -5 2 -6 0 -6 -4 -5 -6 -64 0 4 -1 4 2 3 4 1 5 -64 0 -1 5 -3 4 -4 3 -5 0 -5 -4 -4 -7 -3 -8 -1 -9 -64 -64 3106 85 -16 -9 12 -7 7 5 10 5 11 4 11 4 9 6 9 6 11 5 12 2 12 0 11 -1 10 -2 7 -2 -9 -64 0 0 10 -1 7 -1 -8 -64 0 2 12 1 11 0 9 0 -9 -64 0 -5 5 4 5 -64 0 -5 -9 3 -9 -64 0 -2 -8 -4 -9 -64 0 -2 -7 -3 -9 -64 0 0 -7 1 -9 -64 0 0 -8 2 -9 -64 -64 3107 183 -16 -9 12 -9 10 6 4 7 3 8 4 7 5 6 5 4 4 3 3 -64 0 -1 5 -3 4 -4 3 -5 1 -5 -1 -4 -3 -3 -4 -1 -5 1 -5 3 -4 4 -3 5 -1 5 1 4 3 3 4 1 5 -1 5 -64 0 -3 3 -4 1 -4 -1 -3 -3 -64 0 3 -3 4 -1 4 1 3 3 -64 0 -1 5 -2 4 -3 2 -3 -2 -2 -4 -1 -5 -64 0 1 -5 2 -4 3 -2 3 2 2 4 1 5 -64 0 -4 -3 -5 -4 -6 -6 -6 -7 -5 -9 -4 -10 -1 -11 3 -11 6 -12 7 -13 -64 0 -4 -9 -1 -10 3 -10 6 -11 -64 0 -6 -7 -5 -8 -2 -9 3 -9 6 -10 7 -12 7 -13 6 -15 3 -16 -3 -16 -6 -15 -7 -13 -7 -12 -6 -10 -3 -9 -64 0 -3 -16 -5 -15 -6 -13 -6 -12 -5 -10 -3 -9 -64 -64 3108 135 -16 -9 12 -11 12 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -9 12 -4 12 -4 -9 -64 0 -4 1 -3 3 -2 4 0 5 3 5 5 4 6 3 7 0 7 -9 -64 0 5 3 6 0 6 -8 -64 0 3 5 4 4 5 1 5 -9 -64 0 -9 -9 -1 -9 -64 0 2 -9 10 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 0 5 -8 3 -9 -64 0 5 -7 4 -9 -64 0 7 -7 8 -9 -64 0 7 -8 9 -9 -64 -64 3109 91 -16 -9 12 -6 6 -1 12 -1 10 1 10 1 12 -1 12 -64 0 0 12 0 10 -64 0 -1 11 1 11 -64 0 -1 5 -1 -9 -64 0 0 4 0 -8 -64 0 -4 5 1 5 1 -9 -64 0 -4 -9 4 -9 -64 0 -3 5 -1 4 -64 0 -2 5 -1 3 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3110 87 -16 -9 12 -7 6 0 12 0 10 2 10 2 12 0 12 -64 0 1 12 1 10 -64 0 0 11 2 11 -64 0 0 5 0 -12 -1 -15 -2 -16 -64 0 1 4 1 -11 0 -14 -64 0 -3 5 2 5 2 -11 1 -14 0 -15 -2 -16 -5 -16 -6 -15 -6 -13 -4 -13 -4 -15 -5 -15 -5 -14 -64 0 -2 5 0 4 -64 0 -1 5 0 3 -64 -64 3111 127 -16 -9 12 -11 11 -6 12 -6 -9 -64 0 -5 11 -5 -8 -64 0 -9 12 -4 12 -4 -9 -64 0 5 4 -4 -5 -64 0 0 -1 7 -9 -64 0 0 -2 6 -9 -64 0 -1 -2 5 -9 -64 0 2 5 9 5 -64 0 -9 -9 -1 -9 -64 0 2 -9 9 -9 -64 0 -8 12 -6 11 -64 0 -7 12 -6 10 -64 0 3 5 5 4 -64 0 8 5 5 4 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 0 5 -7 3 -9 -64 0 4 -7 8 -9 -64 -64 3112 67 -16 -9 12 -6 6 -1 12 -1 -9 -64 0 0 11 0 -8 -64 0 -4 12 1 12 1 -9 -64 0 -4 -9 4 -9 -64 0 -3 12 -1 11 -64 0 -2 12 -1 10 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3113 203 -16 -9 12 -17 17 -12 5 -12 -9 -64 0 -11 4 -11 -8 -64 0 -15 5 -10 5 -10 -9 -64 0 -10 1 -9 3 -8 4 -6 5 -3 5 -1 4 0 3 1 0 1 -9 -64 0 -1 3 0 0 0 -8 -64 0 -3 5 -2 4 -1 1 -1 -9 -64 0 1 1 2 3 3 4 5 5 8 5 10 4 11 3 12 0 12 -9 -64 0 10 3 11 0 11 -8 -64 0 8 5 9 4 10 1 10 -9 -64 0 -15 -9 -7 -9 -64 0 -4 -9 4 -9 -64 0 7 -9 15 -9 -64 0 -14 5 -12 4 -64 0 -13 5 -12 3 -64 0 -12 -8 -14 -9 -64 0 -12 -7 -13 -9 -64 0 -10 -7 -9 -9 -64 0 -10 -8 -8 -9 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 0 10 -8 8 -9 -64 0 10 -7 9 -9 -64 0 12 -7 13 -9 -64 0 12 -8 14 -9 -64 -64 3114 135 -16 -9 12 -11 12 -6 5 -6 -9 -64 0 -5 4 -5 -8 -64 0 -9 5 -4 5 -4 -9 -64 0 -4 1 -3 3 -2 4 0 5 3 5 5 4 6 3 7 0 7 -9 -64 0 5 3 6 0 6 -8 -64 0 3 5 4 4 5 1 5 -9 -64 0 -9 -9 -1 -9 -64 0 2 -9 10 -9 -64 0 -8 5 -6 4 -64 0 -7 5 -6 3 -64 0 -6 -8 -8 -9 -64 0 -6 -7 -7 -9 -64 0 -4 -7 -3 -9 -64 0 -4 -8 -2 -9 -64 0 5 -8 3 -9 -64 0 5 -7 4 -9 -64 0 7 -7 8 -9 -64 0 7 -8 9 -9 -64 -64 3115 97 -16 -9 12 -10 10 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -1 6 2 4 4 1 5 -1 5 -64 0 -5 2 -6 0 -6 -4 -5 -6 -64 0 5 -6 6 -4 6 0 5 2 -64 0 -1 5 -3 4 -4 3 -5 0 -5 -4 -4 -7 -3 -8 -1 -9 -64 0 1 -9 3 -8 4 -7 5 -4 5 0 4 3 3 4 1 5 -64 -64 3116 125 -16 -9 12 -11 10 -6 5 -6 -16 -64 0 -5 4 -5 -15 -64 0 -9 5 -4 5 -4 -16 -64 0 -4 2 -3 4 -1 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -1 -9 -3 -8 -4 -6 -64 0 5 2 6 0 6 -4 5 -6 -64 0 1 5 3 4 4 3 5 0 5 -4 4 -7 3 -8 1 -9 -64 0 -9 -16 -1 -16 -64 0 -8 5 -6 4 -64 0 -7 5 -6 3 -64 0 -6 -15 -8 -16 -64 0 -6 -14 -7 -16 -64 0 -4 -14 -3 -16 -64 0 -4 -15 -2 -16 -64 -64 3117 115 -16 -9 12 -10 10 4 4 4 -16 -64 0 5 3 5 -15 -64 0 3 4 5 4 6 5 6 -16 -64 0 4 2 3 4 1 5 -1 5 -4 4 -6 2 -7 -1 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 3 -8 4 -6 -64 0 -5 2 -6 0 -6 -4 -5 -6 -64 0 -1 5 -3 4 -4 3 -5 0 -5 -4 -4 -7 -3 -8 -1 -9 -64 0 1 -16 9 -16 -64 0 4 -15 2 -16 -64 0 4 -14 3 -16 -64 0 6 -14 7 -16 -64 0 6 -15 8 -16 -64 -64 3118 91 -16 -9 12 -9 8 -4 5 -4 -9 -64 0 -3 4 -3 -8 -64 0 -7 5 -2 5 -2 -9 -64 0 5 3 5 4 4 4 4 2 6 2 6 4 5 5 3 5 1 4 -1 2 -2 -1 -64 0 -7 -9 1 -9 -64 0 -6 5 -4 4 -64 0 -5 5 -4 3 -64 0 -4 -8 -6 -9 -64 0 -4 -7 -5 -9 -64 0 -2 -7 -1 -9 -64 0 -2 -8 0 -9 -64 -64 3119 91 -16 -9 12 -8 9 5 3 6 5 6 1 5 3 4 4 2 5 -2 5 -4 4 -5 3 -5 1 -4 -1 -2 -2 3 -3 5 -4 6 -7 -64 0 -4 4 -5 1 -64 0 -4 0 -2 -1 3 -2 5 -3 -64 0 6 -4 5 -8 -64 0 -5 3 -4 1 -2 0 3 -1 5 -2 6 -4 6 -7 5 -8 3 -9 -1 -9 -3 -8 -4 -7 -5 -5 -5 -9 -4 -7 -64 -64 3120 49 -16 -9 12 -7 8 -2 10 -2 -4 -1 -7 0 -8 2 -9 4 -9 6 -8 7 -6 -64 0 -1 10 -1 -5 0 -7 -64 0 -2 10 0 12 0 -5 1 -8 2 -9 -64 0 -5 5 4 5 -64 -64 3121 91 -16 -9 12 -11 12 -6 5 -6 -4 -5 -7 -4 -8 -2 -9 1 -9 3 -8 4 -7 5 -5 -64 0 -5 4 -5 -5 -4 -7 -64 0 -9 5 -4 5 -4 -5 -3 -8 -2 -9 -64 0 5 5 5 -9 10 -9 -64 0 6 4 6 -8 -64 0 2 5 7 5 7 -9 -64 0 -8 5 -6 4 -64 0 -7 5 -6 3 -64 0 7 -7 8 -9 -64 0 7 -8 9 -9 -64 -64 3122 67 -16 -9 12 -9 9 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 -4 5 1 -7 -64 0 6 4 1 -7 0 -9 -64 0 -8 5 -1 5 -64 0 2 5 8 5 -64 0 -7 5 -4 3 -64 0 -2 5 -4 4 -64 0 4 5 6 4 -64 0 7 5 6 4 -64 -64 3123 95 -16 -9 12 -12 12 -8 5 -4 -9 -64 0 -7 5 -4 -6 -64 0 -6 5 -3 -6 -64 0 0 5 -3 -6 -4 -9 -64 0 0 5 4 -9 -64 0 1 5 4 -6 -64 0 0 5 2 5 5 -6 -64 0 8 4 5 -6 4 -9 -64 0 -11 5 -3 5 -64 0 5 5 11 5 -64 0 -10 5 -7 4 -64 0 -4 5 -6 4 -64 0 6 5 8 4 -64 0 10 5 8 4 -64 -64 3124 101 -16 -9 12 -10 10 -6 5 4 -9 -64 0 -5 5 5 -9 -64 0 -4 5 6 -9 -64 0 5 4 -5 -8 -64 0 -8 5 -1 5 -64 0 2 5 8 5 -64 0 -8 -9 -2 -9 -64 0 1 -9 8 -9 -64 0 -7 5 -5 4 -64 0 -2 5 -4 4 -64 0 3 5 5 4 -64 0 7 5 5 4 -64 0 -5 -8 -7 -9 -64 0 -5 -8 -3 -9 -64 0 4 -8 2 -9 -64 0 5 -8 7 -9 -64 -64 3125 85 -16 -9 12 -10 9 -6 5 0 -9 -64 0 -5 5 0 -7 -64 0 -4 5 1 -7 -64 0 6 4 1 -7 -2 -13 -4 -15 -6 -16 -8 -16 -9 -15 -9 -13 -7 -13 -7 -15 -8 -15 -8 -14 -64 0 -8 5 -1 5 -64 0 2 5 8 5 -64 0 -7 5 -4 3 -64 0 -2 5 -4 4 -64 0 4 5 6 4 -64 0 7 5 6 4 -64 -64 3126 87 -16 -9 12 -9 9 4 5 -6 -9 -64 0 5 5 -5 -9 -64 0 6 5 -4 -9 -64 0 6 5 -6 5 -6 1 -64 0 -6 -9 6 -9 6 -5 -64 0 -5 5 -6 1 -64 0 -4 5 -6 2 -64 0 -3 5 -6 3 -64 0 -1 5 -6 4 -64 0 1 -9 6 -8 -64 0 3 -9 6 -7 -64 0 4 -9 6 -6 -64 0 5 -9 6 -5 -64 -64 3151 105 -16 -9 12 -11 11 5 5 3 -2 3 -6 4 -8 5 -9 7 -9 9 -7 10 -5 -64 0 6 5 4 -2 4 -8 -64 0 5 5 7 5 5 -2 4 -6 -64 0 3 -2 3 1 2 4 0 5 -2 5 -5 4 -7 1 -8 -2 -8 -4 -7 -7 -6 -8 -4 -9 -2 -9 0 -8 1 -7 2 -5 3 -2 -64 0 -4 4 -6 1 -7 -2 -7 -5 -6 -7 -64 0 -2 5 -4 3 -5 1 -6 -2 -6 -5 -5 -8 -4 -9 -64 -64 3152 109 -16 -9 12 -9 10 -2 12 -4 5 -5 -1 -5 -5 -4 -7 -3 -8 -1 -9 1 -9 4 -8 6 -5 7 -2 7 0 6 3 5 4 3 5 1 5 -1 4 -2 3 -3 1 -4 -2 -64 0 -1 12 -3 5 -4 1 -4 -5 -3 -8 -64 0 4 -7 5 -5 6 -2 6 1 5 3 -64 0 -5 12 0 12 -2 5 -4 -2 -64 0 1 -9 3 -7 4 -5 5 -2 5 1 4 4 3 5 -64 0 -4 12 -1 11 -64 0 -3 12 -2 10 -64 -64 3153 73 -16 -9 12 -9 9 5 1 5 2 4 2 4 0 6 0 6 2 5 4 3 5 0 5 -3 4 -5 1 -6 -2 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -5 -64 0 -3 3 -4 1 -5 -2 -5 -5 -4 -7 -64 0 0 5 -2 3 -3 1 -4 -2 -4 -5 -3 -8 -2 -9 -64 -64 3154 121 -16 -9 12 -11 11 7 12 4 1 3 -3 3 -6 4 -8 5 -9 7 -9 9 -7 10 -5 -64 0 8 12 5 1 4 -3 4 -8 -64 0 4 12 9 12 5 -2 4 -6 -64 0 3 -2 3 1 2 4 0 5 -2 5 -5 4 -7 1 -8 -2 -8 -4 -7 -7 -6 -8 -4 -9 -2 -9 0 -8 1 -7 2 -5 3 -2 -64 0 -5 3 -6 1 -7 -2 -7 -5 -6 -7 -64 0 -2 5 -4 3 -5 1 -6 -2 -6 -5 -5 -8 -4 -9 -64 0 5 12 8 11 -64 0 6 12 7 10 -64 -64 3155 71 -16 -9 12 -9 9 -5 -4 -1 -3 2 -2 5 0 6 2 5 4 3 5 0 5 -3 4 -5 1 -6 -2 -6 -4 -5 -7 -4 -8 -2 -9 0 -9 3 -8 5 -6 -64 0 -3 3 -4 1 -5 -2 -5 -5 -4 -7 -64 0 0 5 -2 3 -3 1 -4 -2 -4 -5 -3 -8 -2 -9 -64 -64 3156 95 -16 -9 12 -8 8 8 10 8 11 7 11 7 9 9 9 9 11 8 12 6 12 4 11 2 9 1 7 0 4 -1 0 -3 -9 -4 -12 -5 -14 -7 -16 -64 0 2 8 1 5 0 0 -2 -9 -3 -12 -64 0 6 12 4 10 3 8 2 5 1 0 -1 -8 -2 -11 -3 -13 -5 -15 -7 -16 -9 -16 -10 -15 -10 -13 -8 -13 -8 -15 -9 -15 -9 -14 -64 0 -4 5 7 5 -64 -64 3157 119 -16 -9 12 -10 11 6 5 2 -9 1 -12 -1 -15 -3 -16 -64 0 7 5 3 -9 1 -13 -64 0 6 5 8 5 4 -9 2 -13 0 -15 -3 -16 -6 -16 -8 -15 -9 -14 -9 -12 -7 -12 -7 -14 -8 -14 -8 -13 -64 0 4 -2 4 1 3 4 1 5 -1 5 -4 4 -6 1 -7 -2 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 1 -8 2 -7 3 -5 4 -2 -64 0 -4 3 -5 1 -6 -2 -6 -5 -5 -7 -64 0 -1 5 -3 3 -4 1 -5 -2 -5 -5 -4 -8 -3 -9 -64 -64 3158 87 -16 -9 12 -11 11 -3 12 -9 -9 -7 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 -1 12 -7 -9 -64 0 -5 -2 -3 2 -1 4 1 5 3 5 5 4 6 2 6 -1 4 -6 -64 0 5 4 5 0 4 -4 4 -8 -64 0 5 2 3 -3 3 -6 4 -8 5 -9 7 -9 9 -7 10 -5 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 -64 3159 75 -16 -9 12 -7 6 2 12 2 10 4 10 4 12 2 12 -64 0 3 12 3 10 -64 0 2 11 4 11 -64 0 -6 1 -5 3 -3 5 -1 5 0 4 1 2 1 -1 -1 -6 -64 0 0 4 0 0 -1 -4 -1 -8 -64 0 0 2 -2 -3 -2 -6 -1 -8 0 -9 2 -9 4 -7 5 -5 -64 -64 3160 95 -16 -9 12 -7 6 3 12 3 10 5 10 5 12 3 12 -64 0 4 12 4 10 -64 0 3 11 5 11 -64 0 -5 1 -4 3 -2 5 0 5 1 4 2 2 2 -1 0 -8 -1 -11 -2 -13 -4 -15 -6 -16 -8 -16 -9 -15 -9 -13 -7 -13 -7 -15 -8 -15 -8 -14 -64 0 1 4 1 -1 -1 -8 -2 -11 -3 -13 -64 0 1 2 0 -2 -2 -9 -3 -12 -4 -14 -6 -16 -64 -64 3161 103 -16 -9 12 -11 11 -3 12 -9 -9 -7 -9 -64 0 -2 12 -8 -9 -64 0 -6 12 -1 12 -7 -9 -64 0 7 3 7 4 6 4 6 2 8 2 8 4 7 5 5 5 3 4 -1 0 -3 -1 -64 0 -5 -1 -3 -1 -1 -2 0 -3 2 -7 3 -8 5 -8 -64 0 -1 -3 1 -7 2 -8 -64 0 -3 -1 -2 -2 0 -8 1 -9 3 -9 5 -8 7 -5 -64 0 -5 12 -2 11 -64 0 -4 12 -3 10 -64 -64 3162 57 -16 -9 12 -6 6 2 12 -1 1 -2 -3 -2 -6 -1 -8 0 -9 2 -9 4 -7 5 -5 -64 0 3 12 0 1 -1 -3 -1 -8 -64 0 -1 12 4 12 0 -2 -1 -6 -64 0 0 12 3 11 -64 0 1 12 2 10 -64 -64 3163 127 -16 -9 12 -18 17 -17 1 -16 3 -14 5 -12 5 -11 4 -10 2 -10 -1 -12 -9 -64 0 -11 4 -11 -1 -13 -9 -64 0 -11 2 -12 -2 -14 -9 -12 -9 -64 0 -10 -1 -8 2 -6 4 -4 5 -2 5 0 4 1 2 1 -1 -1 -9 -64 0 0 4 0 -1 -2 -9 -64 0 0 2 -1 -2 -3 -9 -1 -9 -64 0 1 -1 3 2 5 4 7 5 9 5 11 4 12 2 12 -1 10 -6 -64 0 11 4 11 0 10 -4 10 -8 -64 0 11 2 9 -3 9 -6 10 -8 11 -9 13 -9 15 -7 16 -5 -64 -64 3164 89 -16 -9 12 -12 12 -11 1 -10 3 -8 5 -6 5 -5 4 -4 2 -4 -1 -6 -9 -64 0 -5 4 -5 -1 -7 -9 -64 0 -5 2 -6 -2 -8 -9 -6 -9 -64 0 -4 -1 -2 2 0 4 2 5 4 5 6 4 7 2 7 -1 5 -6 -64 0 6 4 6 0 5 -4 5 -8 -64 0 6 2 4 -3 4 -6 5 -8 6 -9 8 -9 10 -7 11 -5 -64 -64 3165 97 -16 -9 12 -10 10 -1 5 -4 4 -6 1 -7 -2 -7 -4 -6 -7 -5 -8 -2 -9 1 -9 4 -8 6 -5 7 -2 7 0 6 3 5 4 2 5 -1 5 -64 0 -4 3 -5 1 -6 -2 -6 -5 -5 -7 -64 0 4 -7 5 -5 6 -2 6 1 5 3 -64 0 -1 5 -3 3 -4 1 -5 -2 -5 -5 -4 -8 -2 -9 -64 0 1 -9 3 -7 4 -5 5 -2 5 1 4 4 2 5 -64 -64 3166 137 -16 -9 12 -11 11 -10 1 -9 3 -7 5 -5 5 -4 4 -3 2 -3 -1 -4 -5 -7 -16 -64 0 -4 4 -4 -1 -5 -5 -8 -16 -64 0 -4 2 -5 -2 -9 -16 -64 0 -3 -2 -2 1 -1 3 0 4 2 5 4 5 6 4 7 3 8 0 8 -2 7 -5 5 -8 2 -9 0 -9 -2 -8 -3 -5 -3 -2 -64 0 6 3 7 1 7 -2 6 -5 5 -7 -64 0 4 5 5 4 6 1 6 -2 5 -5 4 -7 2 -9 -64 0 -12 -16 -4 -16 -64 0 -8 -15 -11 -16 -64 0 -8 -14 -10 -16 -64 0 -7 -14 -6 -16 -64 0 -8 -15 -5 -16 -64 -64 3167 119 -16 -9 12 -11 10 5 5 -1 -16 -64 0 6 5 0 -16 -64 0 5 5 7 5 1 -16 -64 0 3 -2 3 1 2 4 0 5 -2 5 -5 4 -7 1 -8 -2 -8 -4 -7 -7 -6 -8 -4 -9 -2 -9 0 -8 1 -7 2 -5 3 -2 -64 0 -5 3 -6 1 -7 -2 -7 -5 -6 -7 -64 0 -2 5 -4 3 -5 1 -6 -2 -6 -5 -5 -8 -4 -9 -64 0 -4 -16 4 -16 -64 0 0 -15 -3 -16 -64 0 0 -14 -2 -16 -64 0 1 -14 2 -16 -64 0 0 -15 3 -16 -64 -64 3168 65 -16 -9 12 -9 9 -8 1 -7 3 -5 5 -3 5 -2 4 -1 2 -1 -2 -3 -9 -64 0 -2 4 -2 -2 -4 -9 -64 0 -2 2 -3 -2 -5 -9 -3 -9 -64 0 7 3 7 4 6 4 6 2 8 2 8 4 7 5 5 5 3 4 1 2 -1 -2 -64 -64 3169 99 -16 -9 12 -8 9 6 2 6 3 5 3 5 1 7 1 7 3 6 4 3 5 0 5 -3 4 -4 3 -4 1 -3 -1 -1 -2 2 -3 4 -4 5 -6 -64 0 -3 4 -4 1 -64 0 -3 0 -1 -1 2 -2 4 -3 -64 0 5 -4 4 -8 -64 0 -4 3 -3 1 -1 0 2 -1 4 -2 5 -4 5 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -6 -5 -4 -5 -4 -7 -5 -7 -5 -6 -64 -64 3170 51 -16 -9 12 -7 7 2 12 -1 1 -2 -3 -2 -6 -1 -8 0 -9 2 -9 4 -7 5 -5 -64 0 3 12 0 1 -1 -3 -1 -8 -64 0 2 12 4 12 0 -2 -1 -6 -64 0 -4 5 6 5 -64 -64 3171 89 -16 -9 12 -12 12 -11 1 -10 3 -8 5 -6 5 -5 4 -4 2 -4 -1 -6 -6 -64 0 -5 4 -5 0 -6 -4 -6 -8 -64 0 -5 2 -7 -3 -7 -6 -6 -8 -4 -9 -2 -9 0 -8 2 -6 4 -3 -64 0 6 5 4 -3 4 -6 5 -8 6 -9 8 -9 10 -7 11 -5 -64 0 7 5 5 -3 5 -8 -64 0 6 5 8 5 6 -2 5 -6 -64 -64 3172 63 -16 -9 12 -10 10 -9 1 -8 3 -6 5 -4 5 -3 4 -2 2 -2 -1 -4 -6 -64 0 -3 4 -3 0 -4 -4 -4 -8 -64 0 -3 2 -5 -3 -5 -6 -4 -8 -2 -9 0 -9 2 -8 4 -6 6 -3 7 1 7 5 6 5 6 4 7 2 -64 -64 3173 101 -16 -9 12 -15 15 -14 1 -13 3 -11 5 -9 5 -8 4 -7 2 -7 -1 -9 -6 -64 0 -8 4 -8 0 -9 -4 -9 -8 -64 0 -8 2 -10 -3 -10 -6 -9 -8 -7 -9 -5 -9 -3 -8 -1 -6 0 -3 -64 0 2 5 0 -3 0 -6 1 -8 3 -9 5 -9 7 -8 9 -6 11 -3 12 1 12 5 11 5 11 4 12 2 -64 0 3 5 1 -3 1 -8 -64 0 2 5 4 5 2 -2 1 -6 -64 -64 3174 107 -16 -9 12 -11 11 -8 1 -6 4 -4 5 -2 5 0 4 1 2 1 0 -64 0 -2 5 -1 4 -1 0 -2 -4 -3 -6 -5 -8 -7 -9 -9 -9 -10 -8 -10 -6 -8 -6 -8 -8 -9 -8 -9 -7 -64 0 0 3 0 0 -1 -4 -1 -7 -64 0 8 3 8 4 7 4 7 2 9 2 9 4 8 5 6 5 4 4 2 2 1 0 0 -4 0 -8 1 -9 -64 0 -2 -4 -2 -6 -1 -8 1 -9 3 -9 5 -8 7 -5 -64 -64 3175 103 -16 -9 12 -11 11 -10 1 -9 3 -7 5 -5 5 -4 4 -3 2 -3 -1 -5 -6 -64 0 -4 4 -4 0 -5 -4 -5 -8 -64 0 -4 2 -6 -3 -6 -6 -5 -8 -3 -9 -1 -9 1 -8 3 -6 5 -2 -64 0 7 5 3 -9 2 -12 0 -15 -2 -16 -64 0 8 5 4 -9 2 -13 -64 0 7 5 9 5 5 -9 3 -13 1 -15 -2 -16 -5 -16 -7 -15 -8 -14 -8 -12 -6 -12 -6 -14 -7 -14 -7 -13 -64 -64 3176 83 -16 -9 12 -10 10 7 5 6 3 4 1 -4 -5 -6 -7 -7 -9 -64 0 6 3 -3 3 -5 2 -6 0 -64 0 4 3 0 4 -3 4 -4 3 -64 0 4 3 0 5 -3 5 -5 3 -6 0 -64 0 -6 -7 3 -7 5 -6 6 -4 -64 0 -4 -7 0 -8 3 -8 4 -7 -64 0 -4 -7 0 -9 3 -9 5 -7 6 -4 -64 -64 3197 9 -16 -9 12 0 0 -64 0 -64 -64 3198 9 -16 -9 12 -4 4 -64 0 -64 -64 3199 9 -16 -9 12 -8 8 -64 0 -64 -64 3200 105 -16 -9 12 -10 10 -1 12 -4 11 -6 8 -7 3 -7 0 -6 -5 -4 -8 -1 -9 1 -9 4 -8 6 -5 7 0 7 3 6 8 4 11 1 12 -1 12 -64 0 -4 10 -5 8 -6 4 -6 -1 -5 -5 -4 -7 -64 0 4 -7 5 -5 6 -1 6 4 5 8 4 10 -64 0 -1 12 -3 11 -4 9 -5 4 -5 -1 -4 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 4 -6 5 -1 5 4 4 9 3 11 1 12 -64 -64 3201 61 -16 -9 12 -10 10 -1 10 -1 -9 -64 0 0 10 0 -8 -64 0 1 12 1 -9 -64 0 1 12 -2 9 -4 8 -64 0 -5 -9 5 -9 -64 0 -1 -8 -3 -9 -64 0 -1 -7 -2 -9 -64 0 1 -7 2 -9 -64 0 1 -8 3 -9 -64 -64 3202 129 -16 -9 12 -10 10 -6 8 -6 7 -5 7 -5 8 -6 8 -64 0 -6 9 -5 9 -4 8 -4 7 -5 6 -6 6 -7 7 -7 8 -6 10 -5 11 -2 12 2 12 5 11 6 10 7 8 7 6 6 4 3 2 -2 0 -4 -1 -6 -3 -7 -6 -7 -9 -64 0 5 10 6 8 6 6 5 4 -64 0 2 12 4 11 5 8 5 6 4 4 2 2 -2 0 -64 0 -7 -7 -6 -6 -4 -6 1 -7 5 -7 7 -6 -64 0 -4 -6 1 -8 5 -8 6 -7 -64 0 -4 -6 1 -9 5 -9 6 -8 7 -6 7 -4 -64 -64 3203 157 -16 -9 12 -10 10 -6 8 -6 7 -5 7 -5 8 -6 8 -64 0 -6 9 -5 9 -4 8 -4 7 -5 6 -6 6 -7 7 -7 8 -6 10 -5 11 -2 12 2 12 5 11 6 9 6 6 5 4 2 3 -64 0 4 11 5 9 5 6 4 4 -64 0 1 12 3 11 4 9 4 6 3 4 1 3 -64 0 -1 3 2 3 4 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -3 -4 -4 -4 -5 -5 -6 -6 -6 -64 0 5 0 6 -2 6 -5 5 -7 -64 0 1 3 3 2 4 1 5 -2 5 -5 4 -8 2 -9 -64 0 -6 -4 -6 -5 -5 -5 -5 -4 -6 -4 -64 -64 3204 61 -16 -9 12 -10 10 1 9 1 -9 -64 0 2 10 2 -8 -64 0 3 12 3 -9 -64 0 3 12 -8 -3 8 -3 -64 0 -2 -9 6 -9 -64 0 1 -8 -1 -9 -64 0 1 -7 0 -9 -64 0 3 -7 4 -9 -64 0 3 -8 5 -9 -64 -64 3205 115 -16 -9 12 -10 10 -5 12 -7 2 -5 4 -2 5 1 5 4 4 6 2 7 -1 7 -3 6 -6 4 -8 1 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -4 -6 -3 -5 -3 -4 -4 -4 -5 -5 -6 -6 -6 -64 0 5 2 6 0 6 -4 5 -6 -64 0 1 5 3 4 4 3 5 0 5 -4 4 -7 3 -8 1 -9 -64 0 -6 -4 -6 -5 -5 -5 -5 -4 -6 -4 -64 0 -5 12 5 12 -64 0 -5 11 3 11 -64 0 -5 10 -1 10 3 11 5 12 -64 -64 3206 143 -16 -9 12 -10 10 4 9 4 8 5 8 5 9 4 9 -64 0 5 10 4 10 3 9 3 8 4 7 5 7 6 8 6 9 5 11 3 12 0 12 -3 11 -5 9 -6 7 -7 3 -7 -3 -6 -6 -4 -8 -1 -9 1 -9 4 -8 6 -6 7 -3 7 -2 6 1 4 3 1 4 -1 4 -3 3 -4 2 -5 0 -64 0 -4 9 -5 7 -6 3 -6 -3 -5 -6 -4 -7 -64 0 5 -6 6 -4 6 -1 5 1 -64 0 0 12 -2 11 -3 10 -4 8 -5 4 -5 -3 -4 -6 -3 -8 -1 -9 -64 0 1 -9 3 -8 4 -7 5 -4 5 -1 4 2 3 3 1 4 -64 -64 3207 91 -16 -9 12 -10 10 -7 12 -7 6 -64 0 7 12 7 9 6 6 2 1 1 -1 0 -5 0 -9 -64 0 1 0 0 -2 -1 -5 -1 -9 -64 0 6 6 1 1 -1 -2 -2 -5 -2 -9 0 -9 -64 0 -7 8 -6 10 -4 12 -2 12 3 9 5 9 6 10 7 12 -64 0 -5 10 -4 11 -2 11 0 10 -64 0 -7 8 -6 9 -4 10 -2 10 3 9 -64 -64 3208 163 -16 -9 12 -10 10 -2 12 -5 11 -6 9 -6 6 -5 4 -2 3 2 3 5 4 6 6 6 9 5 11 2 12 -2 12 -64 0 -4 11 -5 9 -5 6 -4 4 -64 0 4 4 5 6 5 9 4 11 -64 0 -2 12 -3 11 -4 9 -4 6 -3 4 -2 3 -64 0 2 3 3 4 4 6 4 9 3 11 2 12 -64 0 -2 3 -5 2 -6 1 -7 -1 -7 -5 -6 -7 -5 -8 -2 -9 2 -9 5 -8 6 -7 7 -5 7 -1 6 1 5 2 2 3 -64 0 -5 1 -6 -1 -6 -5 -5 -7 -64 0 5 -7 6 -5 6 -1 5 1 -64 0 -2 3 -4 2 -5 -1 -5 -5 -4 -8 -2 -9 -64 0 2 -9 4 -8 5 -5 5 -1 4 2 2 3 -64 -64 3209 143 -16 -9 12 -10 10 -5 -5 -5 -6 -4 -6 -4 -5 -5 -5 -64 0 5 3 4 1 3 0 1 -1 -1 -1 -4 0 -6 2 -7 5 -7 6 -6 9 -4 11 -1 12 1 12 4 11 6 9 7 6 7 0 6 -4 5 -6 3 -8 0 -9 -3 -9 -5 -8 -6 -6 -6 -5 -5 -4 -4 -4 -3 -5 -3 -6 -4 -7 -5 -7 -64 0 -5 2 -6 4 -6 7 -5 9 -64 0 4 10 5 9 6 6 6 0 5 -4 4 -6 -64 0 -1 -1 -3 0 -4 1 -5 4 -5 7 -4 10 -3 11 -1 12 -64 0 1 12 3 11 4 9 5 6 5 -1 4 -5 3 -7 2 -8 0 -9 -64 -64 3210 37 -16 -9 12 -5 6 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 3211 53 -16 -9 12 -5 6 2 -8 1 -9 0 -9 -1 -8 -1 -7 0 -6 1 -6 2 -7 2 -10 1 -12 -1 -13 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 0 1 -9 2 -10 -64 0 2 -8 1 -12 -64 -64 3212 69 -16 -9 12 -5 6 0 5 -1 4 -1 3 0 2 1 2 2 3 2 4 1 5 0 5 -64 0 0 4 0 3 1 3 1 4 0 4 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 3213 85 -16 -9 12 -5 6 0 5 -1 4 -1 3 0 2 1 2 2 3 2 4 1 5 0 5 -64 0 0 4 0 3 1 3 1 4 0 4 -64 0 2 -8 1 -9 0 -9 -1 -8 -1 -7 0 -6 1 -6 2 -7 2 -10 1 -12 -1 -13 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 0 1 -9 2 -10 -64 0 2 -8 1 -12 -64 -64 3214 73 -16 -9 12 -5 6 0 12 -1 11 -1 9 0 1 -64 0 0 12 0 -2 1 -2 -64 0 0 12 1 12 1 -2 -64 0 1 12 2 11 2 9 1 1 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 3215 109 -16 -9 12 -9 10 -5 7 -5 8 -4 8 -4 6 -6 6 -6 8 -5 10 -4 11 -2 12 2 12 5 11 6 10 7 8 7 6 6 4 5 3 1 1 -64 0 5 10 6 9 6 5 5 4 -64 0 2 12 4 11 5 9 5 5 4 3 3 2 -64 0 0 1 0 -2 1 -2 1 1 0 1 -64 0 0 -6 -1 -7 -1 -8 0 -9 1 -9 2 -8 2 -7 1 -6 0 -6 -64 0 0 -7 0 -8 1 -8 1 -7 0 -7 -64 -64 3216 53 -16 -9 12 -5 6 2 12 0 11 -1 9 -1 6 0 5 1 5 2 6 2 7 1 8 0 8 -1 7 -64 0 0 7 0 6 1 6 1 7 0 7 -64 0 0 11 -1 7 -64 0 -1 9 0 8 -64 -64 3217 53 -16 -9 12 -5 6 2 10 1 9 0 9 -1 10 -1 11 0 12 1 12 2 11 2 8 1 6 -1 5 -64 0 0 11 0 10 1 10 1 11 0 11 -64 0 1 9 2 8 -64 0 2 10 1 6 -64 -64 3218 153 -16 -9 12 -13 13 9 3 9 4 8 4 8 2 10 2 10 4 9 5 8 5 7 4 6 2 4 -3 2 -6 0 -8 -2 -9 -6 -9 -8 -8 -9 -6 -9 -3 -8 -1 -2 3 0 5 1 7 1 9 0 11 -2 12 -4 11 -5 9 -5 6 -4 3 -2 0 2 -5 5 -8 7 -9 9 -9 10 -7 10 -6 -64 0 -7 -8 -8 -6 -8 -3 -7 -1 -6 0 -64 0 0 5 1 9 -64 0 1 7 0 11 -64 0 -4 11 -5 7 -64 0 -4 4 -2 1 2 -4 5 -7 7 -8 -64 0 -4 -9 -6 -8 -7 -6 -7 -3 -6 -1 -2 3 -64 0 -5 9 -4 5 -1 1 3 -4 6 -7 8 -8 9 -8 10 -7 -64 -64 3219 117 -16 -9 12 -10 10 -2 16 -2 -13 -64 0 2 16 2 -13 -64 0 6 7 6 8 5 8 5 6 7 6 7 8 6 10 5 11 2 12 -2 12 -5 11 -7 9 -7 6 -6 4 -3 2 3 0 5 -1 6 -3 6 -6 5 -8 -64 0 -6 6 -5 4 -3 3 3 1 5 0 6 -2 -64 0 -5 11 -6 9 -6 7 -5 5 -3 4 3 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -7 -3 -5 -3 -5 -5 -6 -5 -6 -4 -64 -64 3220 21 -16 -9 12 -11 12 9 16 -9 -16 -8 -16 -64 0 9 16 10 16 -8 -16 -64 -64 3221 59 -16 -9 12 -7 7 3 16 1 14 -1 11 -3 7 -4 2 -4 -2 -3 -7 -1 -11 1 -14 3 -16 -64 0 -1 10 -2 7 -3 3 -3 -3 -2 -7 -1 -10 -64 0 1 14 0 12 -1 9 -2 3 -2 -3 -1 -9 0 -12 1 -14 -64 -64 3222 59 -16 -9 12 -7 7 -3 16 -1 14 1 11 3 7 4 2 4 -2 3 -7 1 -11 -1 -14 -3 -16 -64 0 1 10 2 7 3 3 3 -3 2 -7 1 -10 -64 0 -1 14 0 12 1 9 2 3 2 -3 1 -9 0 -12 -1 -14 -64 -64 3223 83 -16 -9 12 -8 8 0 12 -1 11 1 1 0 0 -64 0 0 12 0 0 -64 0 0 12 1 11 -1 1 0 0 -64 0 -5 9 -4 9 4 3 5 3 -64 0 -5 9 5 3 -64 0 -5 9 -5 8 5 4 5 3 -64 0 5 9 4 9 -4 3 -5 3 -64 0 5 9 -5 3 -64 0 5 9 5 8 -5 4 -5 3 -64 -64 3224 21 -16 -9 12 -12 13 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3225 37 -16 -9 12 -12 13 0 9 0 -8 1 -8 -64 0 0 9 1 9 1 -8 -64 0 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3226 37 -16 -9 12 -12 13 -8 5 9 5 9 4 -64 0 -8 5 -8 4 9 4 -64 0 -8 -3 9 -3 9 -4 -64 0 -8 -3 -8 -4 9 -4 -64 -64 3227 27 -16 -9 12 -4 5 1 12 0 11 0 5 -64 0 1 11 0 5 -64 0 1 12 2 11 0 5 -64 -64 3228 49 -16 -9 12 -9 9 -4 12 -5 11 -5 5 -64 0 -4 11 -5 5 -64 0 -4 12 -3 11 -5 5 -64 0 5 12 4 11 4 5 -64 0 5 11 4 5 -64 0 5 12 6 11 4 5 -64 -64 3229 65 -16 -9 12 -7 7 -1 12 -3 11 -4 9 -4 7 -3 5 -1 4 1 4 3 5 4 7 4 9 3 11 1 12 -1 12 -64 0 -1 12 -4 9 -3 5 1 4 4 7 3 11 -1 12 -64 0 1 12 -3 11 -4 7 -1 4 3 5 4 9 1 12 -64 -64 3247 9 -16 -9 12 0 0 -64 0 -64 -64 3248 9 -16 -9 12 -4 4 -64 0 -64 -64 3249 9 -16 -9 12 -8 8 -64 0 -64 -64 3250 121 -16 -9 12 -10 11 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -3 -9 -1 -9 2 -8 4 -6 6 -3 7 0 8 4 8 7 7 10 6 11 4 12 2 12 -64 0 -1 10 -3 8 -4 6 -5 3 -6 -1 -6 -5 -5 -7 -64 0 2 -7 4 -5 5 -3 6 0 7 4 7 8 6 10 -64 0 2 12 0 11 -2 8 -3 6 -4 3 -5 -1 -5 -6 -4 -8 -3 -9 -64 0 -1 -9 1 -8 3 -5 4 -3 5 0 6 4 6 9 5 11 4 12 -64 -64 3251 45 -16 -9 12 -10 11 2 8 -3 -9 -1 -9 -64 0 5 12 3 8 -2 -9 -64 0 5 12 -1 -9 -64 0 5 12 2 9 -1 7 -3 6 -64 0 2 8 0 7 -3 6 -64 -64 3252 109 -16 -9 12 -10 11 -3 7 -3 8 -2 8 -2 6 -4 6 -4 8 -3 10 -2 11 1 12 4 12 7 11 8 9 8 7 7 5 5 3 -5 -3 -7 -5 -9 -9 -64 0 6 11 7 9 7 7 6 5 4 3 1 1 -64 0 4 12 5 11 6 9 6 7 5 5 3 3 -5 -3 -64 0 -8 -7 -7 -6 -5 -6 0 -7 5 -7 6 -6 -64 0 -5 -6 0 -8 5 -8 -64 0 -5 -6 0 -9 3 -9 5 -8 6 -6 6 -5 -64 -64 3253 133 -16 -9 12 -10 11 -3 7 -3 8 -2 8 -2 6 -4 6 -4 8 -3 10 -2 11 1 12 4 12 7 11 8 9 8 7 7 5 6 4 4 3 1 2 -64 0 6 11 7 9 7 7 6 5 5 4 -64 0 4 12 5 11 6 9 6 7 5 5 3 3 1 2 -64 0 -1 2 1 2 4 1 5 0 6 -2 6 -5 5 -7 3 -8 0 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -3 -6 -3 -6 -5 -7 -5 -7 -4 -64 0 4 0 5 -2 5 -5 4 -7 -64 0 1 2 3 1 4 -1 4 -5 3 -7 2 -8 0 -9 -64 -64 3254 35 -16 -9 12 -10 11 5 8 0 -9 2 -9 -64 0 8 12 6 8 1 -9 -64 0 8 12 2 -9 -64 0 8 12 -8 -3 8 -3 -64 -64 3255 103 -16 -9 12 -10 11 -1 12 -6 2 -64 0 -1 12 9 12 -64 0 -1 11 7 11 -64 0 -2 10 3 10 7 11 9 12 -64 0 -6 2 -5 3 -2 4 1 4 4 3 5 2 6 0 6 -3 5 -6 3 -8 -1 -9 -4 -9 -6 -8 -7 -7 -8 -5 -8 -3 -6 -3 -6 -5 -7 -5 -7 -4 -64 0 4 2 5 0 5 -3 4 -6 2 -8 -64 0 1 4 3 3 4 1 4 -3 3 -6 1 -8 -1 -9 -64 -64 3256 127 -16 -9 12 -10 11 7 8 7 9 6 9 6 7 8 7 8 9 7 11 5 12 2 12 -1 11 -3 9 -5 6 -6 3 -7 -1 -7 -4 -6 -7 -5 -8 -3 -9 0 -9 3 -8 5 -6 6 -4 6 -1 5 1 4 2 2 3 -1 3 -3 2 -4 1 -5 -1 -64 0 -2 9 -4 6 -5 3 -6 -1 -6 -5 -5 -7 -64 0 4 -6 5 -4 5 -1 4 1 -64 0 2 12 0 11 -2 8 -3 6 -4 3 -5 -1 -5 -6 -4 -8 -3 -9 -64 0 0 -9 2 -8 3 -7 4 -4 4 0 3 2 2 3 -64 -64 3257 83 -16 -9 12 -10 11 -4 12 -6 6 -64 0 9 12 8 9 6 6 2 1 0 -2 -1 -5 -2 -9 -64 0 0 -1 -2 -5 -3 -9 -64 0 6 6 0 0 -2 -3 -3 -5 -4 -9 -2 -9 -64 0 -5 9 -2 12 0 12 5 9 -64 0 -3 11 0 11 5 9 -64 0 -5 9 -3 10 0 10 5 9 7 9 8 10 9 12 -64 -64 3258 213 -16 -9 12 -10 11 1 12 -2 11 -3 10 -4 8 -4 5 -3 3 -1 2 2 2 5 3 7 4 8 6 8 9 7 11 5 12 1 12 -64 0 3 12 -2 11 -64 0 -2 10 -3 8 -3 4 -2 3 -64 0 -3 3 0 2 -64 0 1 2 5 3 -64 0 6 4 7 6 7 9 6 11 -64 0 7 11 3 12 -64 0 1 12 -1 10 -2 8 -2 4 -1 2 -64 0 2 2 4 3 5 4 6 6 6 10 5 12 -64 0 -1 2 -5 1 -7 -1 -8 -3 -8 -6 -7 -8 -4 -9 0 -9 4 -8 5 -7 6 -5 6 -2 5 0 4 1 2 2 -64 0 0 2 -5 1 -64 0 -4 1 -6 -1 -7 -3 -7 -6 -6 -8 -64 0 -7 -8 -2 -9 4 -8 -64 0 4 -7 5 -5 5 -2 4 0 -64 0 4 1 1 2 -64 0 -1 2 -3 1 -5 -1 -6 -3 -6 -6 -5 -8 -4 -9 -64 0 0 -9 2 -8 3 -7 4 -5 4 -1 3 1 2 2 -64 -64 3259 127 -16 -9 12 -10 11 6 4 5 2 4 1 2 0 -1 0 -3 1 -4 2 -5 4 -5 7 -4 9 -2 11 1 12 4 12 6 11 7 10 8 7 8 4 7 0 6 -3 4 -6 2 -8 -1 -9 -4 -9 -6 -8 -7 -6 -7 -4 -5 -4 -5 -6 -6 -6 -6 -5 -64 0 -3 2 -4 4 -4 7 -3 9 -64 0 6 10 7 8 7 4 6 0 5 -3 3 -6 -64 0 -1 0 -2 1 -3 3 -3 7 -2 10 -1 11 1 12 -64 0 4 12 5 11 6 9 6 4 5 0 4 -3 3 -5 1 -8 -1 -9 -64 -64 3260 37 -16 -9 12 -5 6 -2 -6 -3 -7 -3 -8 -2 -9 -1 -9 0 -8 0 -7 -1 -6 -2 -6 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 -64 3261 49 -16 -9 12 -5 6 -1 -9 -2 -9 -3 -8 -3 -7 -2 -6 -1 -6 0 -7 0 -9 -1 -11 -2 -12 -4 -13 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 0 -1 -9 -1 -10 -2 -12 -64 -64 3262 69 -16 -9 12 -5 6 1 5 0 4 0 3 1 2 2 2 3 3 3 4 2 5 1 5 -64 0 1 4 1 3 2 3 2 4 1 4 -64 0 -2 -6 -3 -7 -3 -8 -2 -9 -1 -9 0 -8 0 -7 -1 -6 -2 -6 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 -64 3263 81 -16 -9 12 -5 6 1 5 0 4 0 3 1 2 2 2 3 3 3 4 2 5 1 5 -64 0 1 4 1 3 2 3 2 4 1 4 -64 0 -1 -9 -2 -9 -3 -8 -3 -7 -2 -6 -1 -6 0 -7 0 -9 -1 -11 -2 -12 -4 -13 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 0 -1 -9 -1 -10 -2 -12 -64 -64 3264 73 -16 -9 12 -5 6 4 12 3 12 2 11 0 -2 -64 0 4 11 3 11 0 -2 -64 0 4 11 4 10 0 -2 -64 0 4 12 5 11 5 10 0 -2 -64 0 -2 -6 -3 -7 -3 -8 -2 -9 -1 -9 0 -8 0 -7 -1 -6 -2 -6 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 -64 3265 123 -16 -9 12 -10 11 -3 7 -3 8 -2 8 -2 6 -4 6 -4 8 -3 10 -2 11 1 12 5 12 8 11 9 9 9 7 8 5 7 4 5 3 1 2 -1 1 -1 -1 1 -2 2 -2 -64 0 3 12 8 11 -64 0 7 11 8 9 8 7 7 5 6 4 4 3 -64 0 5 12 6 11 7 9 7 7 6 5 5 4 1 2 0 1 0 -1 1 -2 -64 0 -2 -6 -3 -7 -3 -8 -2 -9 -1 -9 0 -8 0 -7 -1 -6 -2 -6 -64 0 -2 -7 -2 -8 -1 -8 -1 -7 -2 -7 -64 -64 3266 49 -16 -9 12 -5 6 5 12 3 11 2 10 1 8 1 6 2 5 3 5 4 6 4 7 3 8 2 8 -64 0 3 11 2 9 2 8 -64 0 2 7 2 6 3 6 3 7 2 7 -64 -64 3267 49 -16 -9 12 -5 6 4 9 3 9 2 10 2 11 3 12 4 12 5 11 5 9 4 7 3 6 1 5 -64 0 3 11 3 10 4 10 4 11 3 11 -64 0 4 9 4 8 3 6 -64 -64 3268 149 -16 -9 12 -13 13 10 3 10 4 9 4 9 2 11 2 11 4 10 5 9 5 7 4 5 2 0 -6 -2 -8 -4 -9 -7 -9 -10 -8 -11 -6 -11 -4 -10 -2 -9 -1 -7 0 -2 2 0 3 2 5 3 7 3 9 2 11 0 12 -2 11 -3 9 -3 6 -2 0 -1 -3 0 -5 2 -8 4 -9 6 -9 7 -7 7 -6 -64 0 -6 -9 -10 -8 -64 0 -9 -8 -10 -6 -10 -4 -9 -2 -8 -1 -6 0 -64 0 -2 2 -1 -1 2 -7 4 -8 -64 0 -7 -9 -8 -8 -9 -6 -9 -4 -8 -2 -7 -1 -5 0 0 3 -64 0 -3 6 -2 3 -1 0 1 -4 3 -7 5 -8 6 -8 7 -7 -64 -64 3269 109 -16 -9 12 -10 11 2 16 -6 -13 -64 0 7 16 -1 -13 -64 0 8 7 8 8 7 8 7 6 9 6 9 8 8 10 7 11 4 12 0 12 -3 11 -5 9 -5 6 -4 4 -2 2 4 -1 5 -3 5 -6 4 -8 -64 0 -4 6 -3 4 4 0 5 -2 -64 0 -3 11 -4 9 -4 7 -3 5 3 2 5 0 6 -2 6 -5 5 -7 4 -8 1 -9 -3 -9 -6 -8 -7 -7 -8 -5 -8 -3 -6 -3 -6 -5 -7 -5 -7 -4 -64 -64 3270 21 -16 -9 12 -11 12 13 16 -13 -16 -12 -16 -64 0 13 16 14 16 -12 -16 -64 -64 3271 69 -16 -9 12 -8 8 8 16 6 15 3 13 0 10 -2 7 -4 3 -5 -1 -5 -6 -4 -10 -3 -13 -1 -16 -64 0 1 10 -1 7 -3 3 -4 -2 -4 -10 -64 0 8 16 5 14 2 11 0 8 -1 6 -2 3 -3 -1 -4 -10 -64 0 -4 -2 -3 -11 -2 -14 -1 -16 -64 -64 3272 69 -16 -9 12 -8 8 1 16 3 13 4 10 5 6 5 1 4 -3 2 -7 0 -10 -3 -13 -6 -15 -8 -16 -64 0 4 10 4 2 3 -3 1 -7 -1 -10 -64 0 1 16 2 14 3 11 4 2 -64 0 4 10 3 1 2 -3 1 -6 0 -8 -2 -11 -5 -14 -8 -16 -64 -64 3273 83 -16 -9 12 -8 9 2 12 1 11 3 1 2 0 -64 0 2 12 2 0 -64 0 2 12 3 11 1 1 2 0 -64 0 -3 9 -2 9 6 3 7 3 -64 0 -3 9 7 3 -64 0 -3 9 -3 8 7 4 7 3 -64 0 7 9 6 9 -2 3 -3 3 -64 0 7 9 -3 3 -64 0 7 9 7 8 -3 4 -3 3 -64 -64 3274 21 -16 -9 12 -12 13 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3275 37 -16 -9 12 -12 13 0 9 0 -8 1 -8 -64 0 0 9 1 9 1 -8 -64 0 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3276 37 -16 -9 12 -12 13 -8 5 9 5 9 4 -64 0 -8 5 -8 4 9 4 -64 0 -8 -3 9 -3 9 -4 -64 0 -8 -3 -8 -4 9 -4 -64 -64 3277 27 -16 -9 12 -5 5 3 12 2 11 0 5 -64 0 3 11 0 5 -64 0 3 12 4 11 0 5 -64 -64 3278 49 -16 -9 12 -10 10 -2 12 -3 11 -5 5 -64 0 -2 11 -5 5 -64 0 -2 12 -1 11 -5 5 -64 0 8 12 7 11 5 5 -64 0 8 11 5 5 -64 0 8 12 9 11 5 5 -64 -64 3279 65 -16 -9 12 -7 8 1 12 -1 11 -2 9 -2 7 -1 5 1 4 3 4 5 5 6 7 6 9 5 11 3 12 1 12 -64 0 1 12 -2 9 -1 5 3 4 6 7 5 11 1 12 -64 0 3 12 -1 11 -2 7 1 4 5 5 6 9 3 12 -64 -64 3301 129 -16 -9 12 -12 12 -9 10 -8 9 -9 8 -10 9 -9 11 -7 12 -5 12 -3 11 -2 10 -1 7 -1 3 -2 0 -4 -2 -6 -3 -9 -4 -64 0 -3 10 -2 7 -2 2 -3 0 -64 0 -5 12 -4 11 -3 8 -3 2 -4 -1 -6 -3 -64 0 -6 -4 -3 -7 -64 0 -7 -4 -3 -8 -64 0 -9 -4 -4 -9 3 -4 -64 0 10 11 9 10 10 10 10 11 9 12 7 12 5 11 4 10 3 8 3 -7 5 -9 9 -5 -64 0 5 10 4 8 4 -6 6 -8 -64 0 7 12 6 11 5 8 5 -5 7 -7 -64 -64 3302 207 -16 -9 12 -13 13 -11 1 -11 0 -10 -1 -8 -1 -6 0 -6 3 -7 5 -9 8 -9 10 -7 12 -64 0 -7 3 -9 7 -64 0 -8 -1 -7 0 -7 2 -9 5 -10 7 -10 9 -9 11 -7 12 -4 12 -2 11 -1 10 0 8 0 0 -1 -3 -3 -5 -64 0 -2 10 -1 8 -1 -2 -64 0 -4 12 -3 11 -2 8 -2 -3 -3 -5 -64 0 0 9 1 11 3 12 5 12 7 11 8 10 9 8 10 7 -64 0 7 10 8 8 -64 0 5 12 6 11 7 8 8 7 10 7 -64 0 10 7 0 2 -64 0 7 5 9 3 10 0 10 -3 9 -6 7 -8 4 -9 1 -9 -2 -8 -8 -5 -9 -5 -10 -6 -64 0 6 4 7 4 9 2 -64 0 4 4 7 3 9 1 10 -1 -64 0 2 -8 0 -8 -6 -5 -7 -5 -64 0 8 -7 6 -8 3 -8 0 -7 -4 -5 -7 -4 -9 -4 -10 -6 -10 -8 -9 -9 -8 -8 -9 -7 -64 -64 3303 163 -16 -9 12 -12 12 0 10 -2 12 -4 12 -6 11 -8 8 -9 4 -9 0 -8 -4 -6 -7 -4 -8 -1 -9 2 -9 5 -8 7 -7 9 -5 -64 0 -6 10 -7 8 -8 5 -8 0 -7 -4 -5 -7 -2 -8 -64 0 -4 12 -5 11 -6 9 -7 5 -7 1 -6 -3 -5 -5 -3 -7 0 -8 3 -8 6 -7 9 -5 -64 0 3 12 0 10 -1 9 -2 7 -2 6 -1 4 2 2 3 0 3 -2 -64 0 -1 7 -1 6 3 2 3 1 -64 0 -1 9 -1 8 0 6 3 4 4 2 4 0 3 -2 1 -3 0 -3 -2 -2 -3 0 -64 0 3 12 4 11 6 10 8 10 -64 0 3 11 4 10 5 10 -64 0 2 11 4 9 6 9 8 10 9 11 -64 -64 3304 163 -16 -9 12 -13 13 -10 6 -10 7 -9 9 -7 11 -4 12 0 12 3 11 5 10 7 8 9 5 10 1 10 -3 9 -6 7 -8 4 -9 1 -9 -2 -8 -8 -5 -9 -5 -10 -6 -64 0 -7 10 -5 11 0 11 3 10 5 9 7 7 9 4 -64 0 2 -8 0 -8 -6 -5 -7 -5 -64 0 -10 7 -8 9 -5 10 0 10 3 9 5 8 7 6 9 3 10 0 -64 0 8 -7 6 -8 3 -8 0 -7 -4 -5 -7 -4 -9 -4 -10 -6 -10 -8 -9 -9 -8 -8 -9 -7 -64 0 -2 10 -5 7 -6 5 -6 3 -4 -1 -4 -3 -64 0 -5 4 -5 3 -4 1 -4 0 -64 0 -5 7 -5 5 -3 1 -3 -1 -4 -3 -5 -4 -7 -4 -8 -3 -8 -2 -64 -64 3305 195 -16 -9 12 -12 12 0 10 -2 12 -4 12 -6 11 -8 8 -9 4 -9 0 -8 -4 -6 -7 -4 -8 -1 -9 2 -9 5 -8 7 -7 9 -5 -64 0 -6 10 -7 8 -8 5 -8 0 -7 -4 -5 -7 -2 -8 -64 0 -4 12 -5 11 -6 9 -7 5 -7 1 -6 -3 -5 -5 -3 -7 0 -8 3 -8 6 -7 9 -5 -64 0 3 12 0 10 -1 9 -2 7 -2 6 -1 4 2 2 3 0 3 -2 -64 0 -1 7 -1 6 3 2 3 1 -64 0 -1 9 -1 8 0 6 3 4 4 2 4 0 3 -2 1 -3 0 -3 -2 -2 -3 0 -64 0 3 12 4 11 6 10 8 10 -64 0 3 11 4 10 5 10 -64 0 2 11 4 9 6 9 8 10 9 11 -64 0 3 4 7 7 -64 0 7 7 8 6 10 6 -64 0 6 6 7 5 8 5 -64 0 5 5 6 4 8 4 10 6 -64 -64 3306 193 -16 -9 12 -12 12 -5 4 -7 5 -8 7 -8 9 -7 11 -4 12 -1 12 2 11 6 9 -64 0 -7 10 -5 11 0 11 3 10 -64 0 -8 7 -7 9 -5 10 0 10 6 9 8 9 9 10 9 11 8 12 7 12 -64 0 1 10 0 9 -1 7 -1 5 0 3 4 -1 5 -4 5 -7 4 -10 3 -11 1 -12 -64 0 2 2 5 -1 6 -4 6 -7 5 -9 -64 0 -1 5 1 3 4 1 6 -1 7 -4 7 -7 6 -9 4 -11 1 -12 -3 -12 -6 -11 -7 -10 -8 -8 -8 -5 -6 -2 -6 0 -7 1 -64 0 -6 -10 -7 -9 -7 -5 -6 -3 -64 0 -3 -12 -5 -11 -6 -9 -6 -5 -5 -2 -5 0 -6 1 -8 1 -9 0 -9 -1 -64 0 3 2 7 6 -64 0 7 6 8 5 10 5 -64 0 6 5 7 4 8 4 -64 0 5 4 6 3 8 3 10 5 -64 -64 3307 203 -16 -9 12 -13 13 3 8 2 10 1 11 -1 12 -4 12 -7 11 -9 8 -10 4 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 2 -9 5 -8 7 -7 9 -5 10 -2 10 1 9 4 7 6 -64 0 -7 10 -8 8 -9 5 -9 0 -8 -3 -7 -5 -64 0 8 -5 9 -3 9 1 8 4 7 5 -64 0 -4 12 -6 11 -7 9 -8 5 -8 0 -7 -4 -6 -6 -4 -8 -64 0 5 -8 7 -6 8 -3 8 1 7 3 5 5 -64 0 3 12 0 10 -2 8 -3 6 -3 5 -2 3 1 1 2 -1 2 -3 -64 0 -2 6 -2 5 2 1 2 0 -64 0 -2 8 -2 7 -1 5 2 3 3 1 3 -1 2 -3 0 -4 -1 -4 -3 -3 -4 -1 -64 0 2 3 7 6 8 8 -64 0 10 12 8 8 -64 0 7 11 11 9 -64 0 10 12 9 11 7 11 8 10 8 8 9 9 11 9 10 10 10 12 -64 -64 3308 189 -16 -9 12 -12 13 0 12 -2 11 -4 9 -5 7 -5 5 -4 3 -2 1 -1 -1 -1 -3 -64 0 -4 6 -4 5 -1 1 -1 0 -64 0 -4 9 -4 7 -3 5 -1 3 0 1 0 -1 -1 -3 -2 -4 -4 -5 -6 -5 -8 -4 -9 -3 -10 -1 -10 1 -9 2 -8 1 -9 0 -64 0 0 12 2 10 4 10 6 11 -64 0 -1 11 1 10 -64 0 -2 11 -1 10 1 9 3 9 6 11 -64 0 0 2 7 7 -64 0 7 7 9 4 10 1 10 -2 9 -5 7 -7 4 -8 0 -9 -64 0 6 6 8 4 9 1 9 -3 8 -5 -64 0 4 5 5 5 7 3 8 0 8 -4 7 -6 6 -7 4 -8 -64 0 4 -8 2 -8 0 -7 -2 -7 -4 -8 -5 -10 -4 -12 -2 -13 0 -13 2 -12 -64 0 1 -8 -1 -8 -64 0 0 -9 -2 -8 -4 -8 -64 -64 3309 171 -16 -9 12 -12 13 -2 2 -4 2 -6 3 -7 4 -8 6 -8 8 -7 10 -6 11 -3 12 -1 12 2 11 5 8 7 7 -64 0 -6 10 -4 11 0 11 2 10 3 9 -64 0 -8 8 -7 9 -5 10 -1 10 2 9 4 8 7 7 9 7 10 8 10 10 9 11 7 11 -64 0 -8 -6 -7 -7 -8 -8 -9 -7 -9 -5 -8 -4 -6 -4 -4 -5 -2 -7 0 -10 2 -12 -64 0 -4 -6 -3 -7 -1 -10 0 -11 -64 0 -6 -4 -5 -5 -4 -7 -2 -10 -1 -11 1 -12 4 -12 6 -11 7 -10 8 -8 8 -5 7 -3 5 0 4 2 4 3 -64 0 7 -6 7 -5 4 0 4 1 -64 0 6 -11 7 -9 7 -7 6 -5 4 -2 3 0 3 2 5 4 7 4 8 3 8 2 -64 -64 3310 171 -16 -9 12 -12 13 -2 2 -4 2 -6 3 -7 4 -8 6 -8 8 -7 10 -6 11 -3 12 -1 12 2 11 5 8 7 7 -64 0 -6 10 -4 11 0 11 2 10 3 9 -64 0 -8 8 -7 9 -5 10 -1 10 2 9 4 8 7 7 9 7 10 8 10 10 9 11 7 11 -64 0 -8 -6 -7 -7 -8 -8 -9 -7 -9 -5 -8 -4 -6 -4 -4 -5 -2 -7 0 -10 2 -12 -64 0 -4 -6 -3 -7 -1 -10 0 -11 -64 0 -6 -4 -5 -5 -4 -7 -2 -10 -1 -11 1 -12 4 -12 6 -11 7 -10 8 -8 8 -5 7 -3 5 0 4 2 4 3 -64 0 7 -6 7 -5 4 0 4 1 -64 0 6 -11 7 -9 7 -7 6 -5 4 -2 3 0 3 2 5 4 7 4 8 3 8 2 -64 -64 3311 167 -16 -9 12 -13 13 9 7 8 9 6 11 3 12 0 12 -3 11 -5 9 -6 7 -6 4 -5 1 -2 -5 -2 -7 -4 -9 -64 0 -5 4 -5 3 -2 -3 -2 -4 -64 0 -4 10 -5 8 -5 5 -4 3 -2 -1 -1 -4 -1 -6 -2 -8 -4 -9 -6 -9 -8 -8 -64 0 -10 -4 -8 -8 -64 0 -11 -7 -7 -5 -64 0 -10 -4 -10 -6 -11 -7 -9 -7 -8 -8 -8 -6 -7 -5 -9 -5 -10 -4 -64 0 -4 3 -4 5 -3 7 -1 8 2 8 4 7 6 5 7 5 -64 0 3 7 5 5 -64 0 0 8 2 7 3 6 4 4 -64 0 7 5 -2 1 -64 0 3 3 7 -6 8 -7 9 -7 -64 0 2 2 6 -6 8 -8 -64 0 1 2 5 -7 7 -9 10 -6 -64 -64 3312 151 -16 -9 12 -11 12 8 -1 7 -2 4 -2 3 -1 3 1 4 3 6 6 7 8 7 10 -64 0 4 1 4 2 7 6 7 7 -64 0 5 -2 4 -1 4 0 5 2 7 4 8 6 8 8 7 10 6 11 3 12 -2 12 -5 11 -6 10 -7 8 -7 6 -6 4 -4 1 -3 -1 -3 -2 -4 -4 -64 0 -6 7 -6 6 -3 1 -3 0 -64 0 -6 10 -6 8 -5 6 -3 3 -2 1 -2 -1 -3 -3 -5 -5 -8 -7 -64 0 -5 -5 -3 -5 0 -7 3 -8 6 -8 8 -7 -64 0 -4 -6 -3 -6 1 -8 2 -8 -64 0 -8 -7 -6 -6 -5 -6 -1 -8 2 -9 4 -9 7 -8 8 -7 9 -5 -64 -64 3313 261 -16 -9 12 -16 16 -13 1 -13 0 -12 -1 -10 -1 -8 0 -8 3 -9 5 -11 8 -11 10 -9 12 -64 0 -9 3 -11 7 -64 0 -10 -1 -9 0 -9 2 -11 5 -12 7 -12 9 -11 11 -9 12 -7 12 -5 11 -3 9 -2 6 -2 0 -3 -3 -4 -5 -6 -7 -9 -9 -10 -8 -11 -8 -64 0 -4 9 -3 6 -3 0 -4 -3 -5 -5 -64 0 -8 -8 -9 -7 -10 -7 -64 0 -7 12 -5 10 -4 7 -4 0 -5 -4 -6 -6 -7 -7 -8 -6 -9 -6 -12 -9 -64 0 -4 11 -2 12 0 12 2 11 4 9 5 6 5 0 4 -3 3 -5 1 -7 -1 -9 -2 -8 -3 -8 -64 0 3 9 4 6 4 0 3 -4 -64 0 0 -8 -1 -7 -2 -7 -64 0 0 12 2 10 3 7 3 -1 2 -5 1 -7 0 -6 -1 -6 -4 -9 -64 0 3 10 4 11 6 12 8 12 10 11 11 10 12 8 13 7 -64 0 10 10 11 8 -64 0 8 12 9 11 10 8 11 7 13 7 -64 0 13 7 10 5 9 4 8 1 8 -2 9 -6 11 -9 14 -6 -64 0 10 4 9 2 9 -2 10 -5 12 -8 -64 0 13 7 11 5 10 3 10 -1 11 -5 13 -7 -64 -64 3314 197 -16 -9 12 -14 14 -11 1 -11 0 -10 -1 -8 -1 -6 0 -6 3 -7 5 -9 8 -9 10 -7 12 -64 0 -7 3 -9 7 -64 0 -8 -1 -7 0 -7 2 -9 5 -10 7 -10 9 -9 11 -7 12 -4 12 -2 11 0 9 1 6 1 0 0 -3 -1 -5 -3 -7 -6 -9 -7 -8 -9 -8 -11 -9 -64 0 -1 9 0 7 0 0 -1 -3 -2 -5 -3 -6 -64 0 -5 -8 -7 -7 -9 -7 -64 0 -4 12 -2 10 -1 7 -1 0 -2 -4 -4 -7 -6 -6 -8 -6 -11 -9 -64 0 0 10 1 11 3 12 5 12 7 11 8 10 9 8 10 7 -64 0 7 10 8 8 -64 0 5 12 6 11 7 8 8 7 10 7 -64 0 10 7 7 5 6 4 5 1 5 -2 6 -6 8 -9 11 -6 -64 0 7 4 6 2 6 -2 7 -5 9 -8 -64 0 10 7 8 5 7 3 7 -1 8 -5 10 -7 -64 -64 3315 149 -16 -9 12 -14 14 -2 12 -4 11 -6 9 -7 7 -7 5 -5 1 -5 -1 -64 0 -6 6 -6 5 -5 3 -5 2 -64 0 -6 9 -6 7 -4 3 -4 1 -5 -1 -6 -2 -8 -2 -9 -1 -9 0 -64 0 -2 12 -1 11 5 9 8 7 9 5 10 2 10 -1 9 -4 8 -6 6 -8 3 -9 0 -9 -3 -8 -9 -5 -10 -5 -11 -6 -64 0 -2 11 -1 10 5 8 7 7 8 6 -64 0 -2 12 -2 10 -1 9 5 7 7 6 9 4 10 2 -64 0 1 -8 -1 -8 -7 -5 -8 -5 -64 0 7 -7 5 -8 2 -8 -1 -7 -5 -5 -8 -4 -10 -4 -11 -6 -11 -8 -10 -9 -9 -8 -10 -7 -64 -64 3316 205 -16 -9 12 -13 14 -10 1 -10 0 -9 -1 -7 -1 -5 0 -5 3 -6 5 -8 8 -8 10 -6 12 -64 0 -6 3 -8 7 -64 0 -7 -1 -6 0 -6 2 -8 5 -9 7 -9 9 -8 11 -6 12 -3 12 -1 11 0 10 1 8 1 -3 -64 0 1 -5 1 -10 0 -12 -2 -13 -5 -13 -6 -12 -6 -10 -5 -9 -4 -10 -5 -11 -64 0 -1 10 0 8 0 -10 -1 -12 -64 0 -3 12 -2 11 -1 8 -1 -3 -64 0 -1 -5 -1 -10 -2 -12 -3 -13 -64 0 1 8 6 12 -64 0 6 12 8 9 9 7 10 3 10 0 9 -3 7 -6 4 -9 -64 0 5 11 8 7 9 4 9 3 -64 0 4 10 6 8 8 5 9 2 9 -1 8 -4 7 -6 -64 0 5 -7 3 -4 1 -3 -64 0 -1 -3 -3 -4 -5 -6 -64 0 5 -8 3 -5 1 -4 -2 -4 -64 0 4 -9 2 -6 1 -5 -64 0 -1 -5 -3 -5 -5 -6 -64 -64 3317 181 -16 -9 12 -14 14 -2 12 -4 11 -6 9 -7 7 -7 5 -5 1 -5 -1 -64 0 -6 6 -6 5 -5 3 -5 2 -64 0 -6 9 -6 7 -4 3 -4 1 -5 -1 -6 -2 -8 -2 -9 -1 -9 0 -64 0 -2 12 -1 11 5 9 8 7 9 5 10 2 10 -1 9 -4 8 -6 -64 0 6 -8 3 -9 0 -9 -3 -8 -9 -5 -10 -5 -11 -6 -64 0 -2 11 -1 10 5 8 7 7 8 6 -64 0 -2 12 -2 10 -1 9 5 7 7 6 9 4 10 2 -64 0 1 -8 -1 -8 -7 -5 -8 -5 -64 0 6 -8 2 -8 -1 -7 -5 -5 -8 -4 -10 -4 -11 -6 -11 -8 -10 -9 -9 -8 -10 -7 -64 0 2 -6 4 -4 6 -4 10 -8 11 -8 -64 0 5 -5 6 -5 9 -8 -64 0 3 -5 4 -5 8 -9 10 -9 12 -7 -64 -64 3318 197 -16 -9 12 -14 14 -11 1 -11 0 -10 -1 -8 -1 -6 0 -6 3 -7 5 -9 8 -9 10 -7 12 -64 0 -7 3 -9 7 -64 0 -8 -1 -7 0 -7 2 -9 5 -10 7 -10 9 -9 11 -7 12 -4 12 -2 11 -1 10 0 8 0 -4 -1 -6 -3 -8 -5 -9 -7 -9 -9 -8 -64 0 -2 10 -1 8 -1 -4 -2 -6 -64 0 -4 12 -3 11 -2 8 -2 -4 -3 -7 -5 -9 -64 0 -11 -4 -9 -8 -64 0 -12 -7 -8 -5 -64 0 -11 -4 -11 -6 -12 -7 -10 -7 -9 -8 -9 -6 -8 -5 -10 -5 -11 -4 -64 0 0 9 1 11 3 12 5 12 7 11 8 10 9 8 10 7 -64 0 7 10 8 8 -64 0 5 12 6 11 7 8 8 7 10 7 -64 0 10 7 0 2 -64 0 2 3 6 -7 8 -9 11 -6 -64 0 3 3 7 -6 9 -8 -64 0 4 4 8 -6 9 -7 10 -7 -64 -64 3319 171 -16 -9 12 -13 14 10 10 9 11 10 12 11 11 11 9 10 7 8 7 4 9 1 10 -3 10 -7 9 -9 7 -64 0 7 8 4 10 1 11 -3 11 -6 10 -64 0 11 9 10 8 8 8 4 11 1 12 -3 12 -6 11 -8 9 -9 7 -10 4 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 3 -9 6 -8 8 -7 10 -5 11 -2 11 1 10 3 8 4 5 4 3 3 1 0 -1 -1 -3 -1 -64 0 -6 -6 -4 -7 -1 -8 3 -8 7 -7 -64 0 -9 -3 -7 -5 -5 -6 -2 -7 3 -7 7 -6 9 -5 10 -4 11 -2 -64 0 6 3 5 3 1 -1 0 -1 -64 0 11 1 9 3 7 3 5 2 3 -1 1 -2 -1 -2 -3 -1 -4 1 -4 3 -3 5 -1 6 -64 -64 3320 167 -16 -9 12 -12 13 -6 4 -8 5 -9 7 -9 9 -8 11 -5 12 0 12 3 11 7 8 9 8 10 9 -64 0 -8 10 -6 11 0 11 3 10 6 8 -64 0 -9 7 -8 9 -6 10 0 10 3 9 7 7 9 7 10 9 10 11 9 12 8 11 9 10 -64 0 3 9 0 6 -1 4 -1 2 1 -2 1 -4 -64 0 0 3 0 2 1 0 1 -1 -64 0 0 6 0 4 2 0 2 -2 1 -4 0 -5 -2 -5 -3 -4 -3 -2 -64 0 -8 -7 -7 -8 -8 -9 -9 -8 -9 -6 -8 -4 -6 -4 -3 -5 1 -7 4 -8 7 -8 9 -7 -64 0 -6 -5 -5 -5 1 -8 3 -8 -64 0 -9 -6 -8 -5 -7 -5 -5 -6 -1 -8 2 -9 5 -9 8 -8 10 -6 -64 -64 3321 95 -16 -9 12 -11 11 -8 10 -7 10 -6 9 -6 -5 -8 -6 -64 0 -7 11 -5 10 -5 -6 -2 -8 -64 0 -9 9 -6 12 -4 10 -4 -5 -2 -7 0 -7 -64 0 -8 -6 -7 -6 -5 -7 -3 -9 0 -7 4 -4 -64 0 2 10 3 10 4 9 4 -7 6 -9 9 -6 -64 0 3 11 5 10 5 -7 7 -8 -64 0 1 9 4 12 7 10 6 9 6 -6 7 -7 8 -7 -64 -64 3322 205 -16 -9 12 -14 14 -11 1 -11 0 -10 -1 -8 -1 -6 0 -6 3 -7 5 -9 8 -9 10 -7 12 -64 0 -7 3 -9 7 -64 0 -8 -1 -7 0 -7 2 -9 5 -10 7 -10 9 -9 11 -7 12 -4 12 -2 11 -1 10 0 8 0 0 -1 -3 -3 -5 -64 0 -2 10 -1 8 -1 -2 -64 0 -4 12 -3 11 -2 8 -2 -3 -3 -5 -64 0 0 9 1 11 3 12 5 12 7 11 9 8 10 7 -64 0 7 10 8 8 -64 0 5 12 6 11 7 8 8 7 10 7 -64 0 8 7 6 7 5 6 5 4 6 2 9 0 10 -2 -64 0 6 3 9 1 -64 0 5 5 6 4 9 2 10 0 10 -4 9 -6 7 -8 5 -9 1 -9 -2 -8 -8 -5 -9 -5 -10 -6 -64 0 2 -8 0 -8 -6 -5 -7 -5 -64 0 8 -7 6 -8 3 -8 0 -7 -4 -5 -7 -4 -9 -4 -10 -6 -10 -8 -9 -9 -8 -8 -9 -7 -64 -64 3323 291 -16 -9 12 -16 17 -13 1 -13 0 -12 -1 -10 -1 -8 0 -8 3 -9 5 -11 8 -11 10 -9 12 -64 0 -9 3 -11 7 -64 0 -10 -1 -9 0 -9 2 -11 5 -12 7 -12 9 -11 11 -9 12 -6 12 -4 11 -3 10 -2 8 -2 4 -3 1 -5 -2 -7 -4 -64 0 -4 10 -3 8 -3 3 -4 0 -64 0 -6 12 -5 11 -4 8 -4 3 -5 -1 -7 -4 -64 0 -4 11 -2 12 1 12 3 11 -64 0 5 12 2 11 1 9 1 5 2 2 4 -1 5 -3 5 -5 4 -7 -64 0 2 5 2 4 5 -1 5 -2 -64 0 5 12 3 11 2 9 2 6 3 4 5 1 6 -2 6 -4 5 -6 3 -8 1 -9 -3 -9 -5 -8 -7 -6 -9 -5 -11 -5 -12 -6 -64 0 -4 -8 -7 -5 -8 -5 -64 0 -1 -9 -3 -8 -6 -5 -8 -4 -11 -4 -12 -6 -12 -8 -11 -9 -10 -8 -11 -7 -64 0 5 12 8 12 10 11 12 8 13 7 -64 0 10 10 11 8 -64 0 8 12 9 11 10 8 11 7 13 7 -64 0 11 7 9 7 8 6 8 4 9 2 12 0 13 -2 -64 0 9 3 12 1 -64 0 8 5 9 4 12 2 13 0 13 -5 12 -7 11 -8 9 -9 6 -9 3 -8 -64 0 7 -8 6 -8 4 -7 -64 0 12 -7 10 -8 8 -8 6 -7 5 -6 -64 -64 3324 177 -16 -9 12 -12 12 -7 10 -5 10 -3 9 -2 8 -1 5 -1 3 -64 0 -1 1 -1 -3 -2 -6 -5 -9 -7 -8 -9 -9 -64 0 -4 -8 -6 -7 -7 -7 -64 0 -3 -7 -4 -7 -6 -6 -9 -9 -64 0 -5 11 -2 10 -1 9 0 6 0 -3 1 -5 3 -7 5 -8 -64 0 -9 9 -4 12 -2 11 0 9 1 6 1 3 -64 0 1 1 1 -2 2 -5 3 -6 5 -7 7 -7 -64 0 -1 -3 0 -6 2 -8 4 -9 9 -6 -64 0 1 6 2 9 5 12 7 11 9 12 -64 0 4 11 6 10 7 10 -64 0 3 10 4 10 6 9 9 12 -64 0 -7 -1 -5 3 -1 3 -64 0 1 3 5 3 7 5 -64 0 -5 2 5 2 -64 0 -7 -1 -5 1 -1 1 -64 0 1 1 5 1 7 5 -64 -64 3325 153 -16 -9 12 -13 13 -10 1 -10 0 -9 -1 -7 -1 -5 0 -5 3 -6 5 -8 8 -8 10 -6 12 -64 0 -6 3 -8 7 -64 0 -7 -1 -6 0 -6 2 -8 5 -9 7 -9 9 -8 11 -6 12 -3 12 -1 11 0 10 1 8 1 3 0 0 -1 -2 -1 -3 1 -5 2 -5 -64 0 -1 10 0 8 0 2 -1 -1 -2 -3 1 -6 -64 0 -3 12 -2 11 -1 8 -1 2 -2 -2 -3 -4 0 -7 3 -4 -64 0 1 8 9 12 -64 0 7 11 7 -8 6 -11 -64 0 8 11 8 -6 7 -9 -64 0 9 12 9 -4 8 -8 7 -10 5 -12 2 -13 -2 -13 -5 -12 -7 -10 -8 -8 -7 -7 -6 -8 -7 -9 -64 -64 3326 153 -16 -9 12 -12 12 -4 9 -3 11 -1 12 2 12 4 11 5 10 6 8 6 5 5 3 4 2 2 1 -64 0 -1 1 -3 2 -4 4 -64 0 4 10 5 9 5 4 4 3 -64 0 2 12 3 11 4 9 4 4 3 2 2 1 -64 0 -5 -3 -4 -1 -3 0 -1 1 2 1 5 0 7 -2 8 -4 8 -8 7 -10 5 -12 2 -13 -2 -13 -4 -12 -7 -8 -8 -7 -64 0 6 -2 7 -4 7 -8 6 -10 -64 0 2 1 5 -1 6 -3 6 -9 5 -11 4 -12 2 -13 -64 0 -3 -12 -4 -11 -6 -8 -7 -7 -64 0 0 -13 -2 -12 -3 -11 -5 -8 -6 -7 -9 -7 -10 -8 -10 -10 -9 -11 -8 -11 -64 -64 3330 173 -16 -9 12 -12 12 -9 10 -8 9 -9 8 -10 9 -9 11 -7 12 -5 12 -3 11 -2 10 -1 7 -1 3 -2 0 -4 -2 -6 -3 -9 -4 -64 0 -3 10 -2 7 -2 2 -3 0 -64 0 -5 12 -4 11 -3 8 -3 2 -4 -1 -6 -3 -64 0 -6 -4 -3 -7 -64 0 -7 -4 -3 -8 -64 0 -9 -4 -4 -9 3 -4 -64 0 10 11 9 10 10 10 10 11 9 12 7 12 5 11 4 10 3 8 3 -7 5 -9 9 -5 -64 0 5 10 4 8 4 -6 6 -8 -64 0 7 12 6 11 5 8 5 -5 7 -7 -64 0 -2 18 -3 17 -3 13 -64 0 -2 17 -3 13 -64 0 -2 18 -1 17 -3 13 -64 0 5 18 4 17 4 13 -64 0 5 17 4 13 -64 0 5 18 6 17 4 13 -64 -64 3331 193 -16 -9 12 -14 14 -2 12 -4 11 -6 9 -7 7 -7 5 -5 1 -5 -1 -64 0 -6 6 -6 5 -5 3 -5 2 -64 0 -6 9 -6 7 -4 3 -4 1 -5 -1 -6 -2 -8 -2 -9 -1 -9 0 -64 0 -2 12 -1 11 5 9 8 7 9 5 10 2 10 -1 9 -4 8 -6 6 -8 3 -9 0 -9 -3 -8 -9 -5 -10 -5 -11 -6 -64 0 -2 11 -1 10 5 8 7 7 8 6 -64 0 -2 12 -2 10 -1 9 5 7 7 6 9 4 10 2 -64 0 1 -8 -1 -8 -7 -5 -8 -5 -64 0 7 -7 5 -8 2 -8 -1 -7 -5 -5 -8 -4 -10 -4 -11 -6 -11 -8 -10 -9 -9 -8 -10 -7 -64 0 -2 18 -3 17 -3 13 -64 0 -2 17 -3 13 -64 0 -2 18 -1 17 -3 13 -64 0 5 18 4 17 4 13 -64 0 5 17 4 13 -64 0 5 18 6 17 4 13 -64 -64 3332 139 -16 -9 12 -11 11 -8 10 -7 10 -6 9 -6 -5 -8 -6 -64 0 -7 11 -5 10 -5 -6 -2 -8 -64 0 -9 9 -6 12 -4 10 -4 -5 -2 -7 0 -7 -64 0 -8 -6 -7 -6 -5 -7 -3 -9 0 -7 4 -4 -64 0 2 10 3 10 4 9 4 -7 6 -9 9 -6 -64 0 3 11 5 10 5 -7 7 -8 -64 0 1 9 4 12 7 10 6 9 6 -6 7 -7 8 -7 -64 0 -3 18 -4 17 -4 13 -64 0 -3 17 -4 13 -64 0 -3 18 -2 17 -4 13 -64 0 4 18 3 17 3 13 -64 0 4 17 3 13 -64 0 4 18 5 17 3 13 -64 -64 3401 97 -16 -9 12 -8 9 2 5 -1 4 -3 3 -4 2 -5 -1 -5 -4 -4 -7 -3 -9 3 -6 -64 0 -4 -4 -3 -7 -2 -8 -64 0 -1 4 -3 2 -4 -1 -4 -3 -3 -6 -1 -8 -64 0 0 4 1 3 3 2 3 -7 5 -9 8 -6 -64 0 1 4 4 2 4 -6 6 -8 -64 0 2 5 3 4 5 3 6 3 -64 0 5 2 6 3 -64 0 5 2 5 -6 6 -7 7 -7 -64 -64 3402 105 -16 -9 12 -8 9 -6 10 -5 9 -4 7 -64 0 2 12 -1 11 -3 9 -4 7 -4 -6 -5 -7 -64 0 -2 9 -3 7 -3 -6 0 -8 -64 0 2 12 0 11 -1 10 -2 7 -2 -6 0 -7 1 -8 -64 0 -5 -7 -4 -7 -2 -8 -1 -9 2 -8 -64 0 -2 2 4 5 5 3 6 0 6 -3 5 -6 4 -7 2 -8 -64 0 3 4 4 3 5 1 -64 0 2 4 4 2 5 -1 5 -3 4 -6 2 -8 -64 -64 3403 59 -16 -9 12 -7 6 0 4 2 2 4 3 2 5 0 4 -3 2 -4 0 -4 -5 -3 -7 -1 -9 3 -7 -64 0 1 4 3 3 -64 0 -2 2 -3 0 -3 -5 -2 -7 -1 -8 -64 0 -1 3 -2 1 -2 -4 -1 -6 1 -8 -64 -64 3404 99 -16 -9 12 -8 9 -1 12 -4 9 -4 7 -3 6 1 4 4 2 5 0 5 -3 4 -6 2 -8 -64 0 -3 8 -3 7 1 5 4 3 5 2 -64 0 -3 10 -3 9 -2 8 3 5 5 3 6 0 6 -3 5 -6 2 -8 -1 -9 -64 0 0 4 -4 2 -4 -6 -5 -7 -64 0 -3 2 -3 -6 0 -8 -64 0 -2 3 -2 -6 0 -7 1 -8 -64 0 -5 -7 -4 -7 -2 -8 -1 -9 -64 -64 3405 59 -16 -9 12 -7 6 -2 -3 4 1 1 5 -3 2 -4 0 -4 -5 -3 -7 -1 -9 3 -7 -64 0 3 1 0 4 -64 0 -2 2 -3 0 -3 -5 -2 -7 -1 -8 -64 0 2 0 0 3 -1 3 -2 1 -2 -4 -1 -6 1 -8 -64 -64 3406 103 -16 -9 12 -6 7 6 12 5 11 3 11 1 12 -1 12 -2 10 -2 5 -3 3 -4 2 -64 0 4 10 2 10 0 11 -1 11 -64 0 6 12 5 10 4 9 2 9 0 10 -1 10 -2 9 -64 0 -2 7 -1 5 0 4 2 3 4 3 4 2 -64 0 -4 2 -2 2 -64 0 0 2 4 2 -64 0 -2 2 -2 -2 -1 -14 -64 0 1 3 -2 3 -1 4 -1 -9 -64 0 0 2 0 -2 -1 -14 -64 -64 3407 111 -16 -9 12 -8 9 2 5 -1 4 -3 3 -4 2 -5 -1 -5 -4 -4 -7 -3 -9 3 -6 -64 0 -4 -5 -3 -7 -2 -8 -64 0 -1 4 -3 2 -4 -1 -4 -3 -3 -6 -1 -8 -64 0 0 4 1 3 3 2 3 -6 4 -9 4 -11 3 -13 -64 0 1 4 4 2 4 -8 -64 0 2 5 3 4 5 3 6 3 -64 0 5 2 6 3 -64 0 5 2 5 -10 4 -12 3 -13 1 -14 -2 -14 -4 -13 -5 -12 -5 -11 -4 -11 -4 -12 -64 -64 3408 105 -16 -9 12 -8 9 -6 10 -5 9 -4 7 -64 0 2 12 -1 11 -3 9 -4 7 -4 -6 -5 -7 -64 0 -2 9 -3 7 -3 -7 -2 -8 -64 0 2 12 0 11 -1 10 -2 7 -2 -6 -1 -7 0 -7 -64 0 -5 -7 -3 -8 -2 -9 1 -6 -64 0 -2 2 4 5 5 3 6 -1 6 -5 5 -8 4 -10 2 -12 -1 -14 -64 0 3 4 4 3 5 0 -64 0 2 4 4 1 5 -2 5 -5 4 -9 2 -12 -64 -64 3409 83 -16 -9 12 -5 5 0 12 -1 11 -1 10 0 9 1 10 1 11 0 12 -64 0 -1 11 1 10 -64 0 -1 10 1 11 -64 0 -3 3 -2 3 -1 2 -1 -7 1 -9 4 -6 -64 0 -2 4 0 3 0 -6 2 -8 -64 0 -4 2 -1 5 0 4 2 3 -64 0 1 2 2 3 -64 0 1 2 1 -6 2 -7 3 -7 -64 -64 3410 95 -16 -9 12 -5 5 0 12 -1 11 -1 10 0 9 1 10 1 11 0 12 -64 0 -1 11 1 10 -64 0 -1 10 1 11 -64 0 -3 3 -2 3 -1 2 -1 -9 -2 -12 -3 -13 -5 -14 -64 0 -2 4 0 3 0 -9 -1 -11 -64 0 -4 2 -1 5 0 4 2 3 -64 0 1 2 2 3 -64 0 1 2 1 -9 0 -11 -2 -13 -5 -14 -64 0 1 -9 2 -11 3 -12 -64 -64 3411 131 -16 -9 12 -7 7 -4 10 -3 9 -2 7 -64 0 3 12 1 11 -1 9 -2 7 -2 5 -3 3 -4 2 -64 0 -2 2 -2 -6 -3 -7 -64 0 0 9 -1 7 -1 5 -64 0 -1 3 -2 3 -1 5 -1 -6 1 -8 -64 0 3 12 1 10 0 7 0 3 -64 0 0 2 0 -6 1 -7 2 -7 -64 0 -3 -7 -1 -8 0 -9 3 -6 -64 0 0 6 4 9 5 8 5 6 3 4 1 3 -64 0 3 8 4 7 4 6 3 4 -64 0 0 3 5 3 5 2 -64 0 -4 2 -2 2 -64 0 0 2 5 2 -64 -64 3412 63 -16 -9 12 -5 5 -3 10 -2 9 -1 7 -64 0 5 12 2 11 0 9 -1 7 -1 -6 -2 -7 -64 0 1 9 0 7 0 -7 2 -8 -64 0 5 12 3 11 2 10 1 7 1 -6 2 -7 3 -7 -64 0 -2 -7 0 -8 1 -9 4 -6 -64 -64 3413 153 -16 -9 12 -13 13 -11 3 -10 3 -9 2 -9 -6 -10 -7 -8 -9 -64 0 -10 4 -8 2 -8 -6 -9 -7 -8 -8 -7 -7 -8 -6 -64 0 -12 2 -9 5 -7 3 -7 -6 -6 -7 -8 -9 -64 0 -4 4 -2 3 -1 1 -1 -6 -2 -7 0 -9 -64 0 -2 4 -1 3 0 1 0 -6 -1 -7 0 -8 1 -7 0 -6 -64 0 -7 2 -4 4 -2 5 0 4 1 2 1 -6 2 -7 0 -9 -64 0 4 4 5 3 7 2 7 -7 9 -9 12 -6 -64 0 5 4 8 2 8 -6 10 -8 -64 0 1 2 4 4 6 5 7 4 9 3 10 3 -64 0 9 2 10 3 -64 0 9 2 9 -6 10 -7 11 -7 -64 -64 3414 103 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -6 -7 -4 -9 -64 0 -6 4 -4 2 -4 -6 -5 -7 -4 -8 -3 -7 -4 -6 -64 0 -8 2 -5 5 -3 3 -3 -6 -2 -7 -4 -9 -64 0 0 4 1 3 3 2 3 -7 5 -9 8 -6 -64 0 1 4 4 2 4 -6 6 -8 -64 0 -3 2 0 4 2 5 3 4 5 3 6 3 -64 0 5 2 6 3 -64 0 5 2 5 -6 6 -7 7 -7 -64 -64 3415 87 -16 -9 12 -8 9 -4 2 -4 -6 -5 -7 -64 0 -3 2 -3 -6 0 -8 -64 0 -1 3 -2 2 -2 -6 0 -7 1 -8 -64 0 -5 -7 -4 -7 -2 -8 -1 -9 2 -8 -64 0 -4 2 -1 3 4 5 5 3 6 0 6 -3 5 -6 4 -7 2 -8 -64 0 3 4 4 3 5 1 -64 0 2 4 4 2 5 -1 5 -3 4 -6 2 -8 -64 -64 3416 119 -16 -9 12 -8 9 -3 8 -5 6 -5 4 -4 1 -4 -6 -6 -8 -64 0 -4 -7 -3 -14 -64 0 -4 5 -4 4 -3 1 -3 -9 -64 0 -4 7 -4 6 -3 4 -2 1 -2 -6 -1 -6 1 -7 2 -8 -64 0 -2 -7 -3 -14 -64 0 1 -8 -1 -7 -64 0 2 -8 0 -9 -2 -7 -64 0 -4 -7 -6 -8 -64 0 -2 2 4 5 5 3 6 0 6 -3 5 -6 4 -7 2 -8 -64 0 3 4 4 3 5 1 -64 0 2 4 4 2 5 -1 5 -3 4 -6 2 -8 -64 -64 3417 91 -16 -9 12 -8 9 2 5 -1 4 -3 3 -4 2 -5 -1 -5 -4 -4 -7 -3 -9 3 -6 -64 0 -4 -5 -3 -7 -2 -8 -64 0 -1 4 -3 2 -4 -1 -4 -3 -3 -6 -1 -8 -64 0 0 4 1 3 3 2 3 -6 4 -14 -64 0 1 4 4 2 4 -9 -64 0 2 5 3 4 5 3 6 3 -64 0 5 2 6 3 -64 0 5 2 5 -6 4 -14 -64 -64 3418 69 -16 -9 12 -7 7 -4 3 -3 3 -2 2 -2 -6 -3 -7 -64 0 -3 4 -1 2 -1 -7 1 -8 -64 0 -5 2 -2 5 0 3 0 -6 1 -7 2 -7 -64 0 -3 -7 -1 -8 0 -9 3 -6 -64 0 2 4 3 2 5 3 4 5 0 3 -64 0 3 4 4 3 -64 -64 3419 89 -16 -9 12 -6 5 6 12 5 11 3 11 1 12 -1 12 -2 10 -2 5 -3 3 -4 2 -64 0 4 10 2 10 0 11 -1 11 -64 0 6 12 5 10 4 9 2 9 0 10 -1 10 -2 9 -64 0 -2 7 0 2 -64 0 -2 2 -2 -2 -1 -14 -64 0 -1 3 -2 3 -1 4 -1 -9 -64 0 0 2 0 -2 -1 -14 -64 0 -4 2 -2 2 -64 -64 3420 79 -16 -9 12 -6 6 1 9 0 6 -1 4 -2 3 -4 2 -64 0 1 9 1 3 4 3 4 2 -64 0 -4 2 -1 2 -64 0 1 2 4 2 -64 0 -1 2 -1 -6 -2 -7 -64 0 0 3 -1 3 0 5 0 -6 2 -8 -64 0 1 2 1 -6 2 -7 3 -7 -64 0 -2 -7 0 -8 1 -9 4 -6 -64 -64 3421 99 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -6 -7 -64 0 -6 4 -4 2 -4 -6 -2 -8 -64 0 -8 2 -5 5 -3 3 -3 -6 -1 -7 0 -8 -64 0 -6 -7 -5 -7 -3 -8 -2 -9 0 -8 3 -6 -64 0 4 5 2 3 3 2 3 -7 5 -9 8 -6 -64 0 4 2 5 3 4 4 3 3 4 2 4 -6 6 -8 -64 0 4 5 6 3 5 2 5 -6 6 -7 7 -7 -64 -64 3422 99 -16 -9 12 -8 9 -3 7 -5 5 -5 3 -4 0 -4 -6 -5 -7 -64 0 -4 4 -4 3 -3 0 -3 -6 0 -8 -64 0 -4 6 -4 5 -3 3 -2 0 -2 -6 0 -7 1 -8 -64 0 -5 -7 -4 -7 -2 -8 -1 -9 2 -8 -64 0 -2 2 4 5 5 3 6 0 6 -3 5 -6 4 -7 2 -8 -64 0 3 4 4 3 5 1 -64 0 2 4 4 2 5 -1 5 -3 4 -6 2 -8 -64 -64 3423 149 -16 -9 12 -12 13 -7 7 -9 5 -9 3 -8 0 -8 -6 -9 -7 -7 -9 -64 0 -8 4 -8 3 -7 0 -7 -6 -8 -7 -7 -8 -6 -7 -7 -6 -64 0 -8 6 -8 5 -7 3 -6 0 -6 -6 -5 -7 -7 -9 -64 0 -3 4 -1 3 0 1 0 -6 -1 -7 -64 0 -1 4 0 3 1 1 1 -6 4 -8 -64 0 -6 2 -3 4 -1 5 1 4 2 2 2 -6 4 -7 5 -8 -64 0 -1 -7 0 -7 2 -8 3 -9 6 -8 -64 0 2 2 8 5 9 3 10 0 10 -2 9 -6 8 -7 6 -8 -64 0 7 4 8 3 9 1 -64 0 6 4 8 2 9 -1 9 -3 8 -6 6 -8 -64 -64 3424 93 -16 -9 12 -7 8 -3 3 -2 3 -1 2 -1 -6 -2 -6 -4 -7 -5 -9 -5 -11 -4 -13 -2 -14 1 -14 4 -13 4 -12 3 -12 3 -13 -64 0 -2 4 0 2 0 -6 3 -8 -64 0 -4 2 -1 5 1 3 1 -6 3 -7 4 -8 -64 0 6 -7 2 -9 1 -8 -1 -7 -3 -7 -5 -9 -64 0 3 4 4 2 6 3 5 5 1 3 -64 0 4 4 5 3 -64 -64 3425 99 -16 -9 12 -8 9 -3 7 -5 5 -5 3 -4 0 -4 -6 -5 -7 -64 0 -4 4 -4 3 -3 0 -3 -7 -1 -8 -64 0 -4 6 -4 5 -3 3 -2 0 -2 -6 -1 -7 0 -7 -64 0 -5 -7 -3 -8 -2 -9 1 -6 -64 0 -2 2 4 5 5 3 6 -1 6 -5 5 -8 4 -10 2 -12 -1 -14 -64 0 3 4 4 3 5 0 -64 0 2 4 4 1 5 -2 5 -5 4 -9 2 -12 -64 -64 3426 91 -16 -9 12 -7 7 -4 2 1 5 3 4 4 2 4 0 3 -2 -1 -4 -64 0 1 4 3 3 -64 0 0 4 2 3 3 1 3 0 2 -2 1 -3 -64 0 1 -3 3 -5 4 -7 4 -11 3 -13 1 -14 -1 -14 -3 -13 -4 -11 -4 -9 -3 -7 -1 -6 5 -4 -64 0 0 -4 2 -5 3 -7 -64 0 -1 -4 2 -6 3 -8 3 -11 2 -13 1 -14 -64 -64 3427 127 -16 -9 12 -8 8 0 5 -2 4 -5 2 -5 0 -4 -3 -64 0 -4 2 -4 0 -3 -2 -64 0 -2 4 -3 3 -3 0 -2 -2 -64 0 -2 4 0 3 2 3 4 4 5 5 5 7 4 8 2 8 -64 0 -1 4 1 4 -64 0 0 5 2 4 4 4 -64 0 -4 -3 4 0 5 -3 5 -5 4 -7 0 -9 -64 0 3 -1 4 -3 4 -6 3 -7 -64 0 2 -1 3 -3 3 -6 2 -8 -64 0 2 -8 0 -7 -3 -7 -6 -9 -64 0 1 -8 -1 -8 -64 0 0 -9 -2 -8 -4 -8 -6 -9 -64 -64 3428 161 -16 -9 12 -8 9 4 12 3 11 1 11 -1 12 -3 12 -4 10 -4 5 -5 3 -6 2 -64 0 2 10 0 10 -2 11 -3 11 -64 0 4 12 3 10 2 9 0 9 -2 10 -3 10 -4 9 -64 0 -4 7 -2 2 -64 0 -4 2 -4 -2 -3 -14 -64 0 -3 3 -4 3 -3 4 -3 -9 -64 0 -2 2 -2 -2 -3 -14 -64 0 -6 2 -4 2 -64 0 -2 2 3 5 5 4 6 2 6 0 5 -2 1 -4 -64 0 3 4 5 3 -64 0 2 4 4 3 5 1 5 0 4 -2 3 -3 -64 0 3 -3 5 -4 6 -6 6 -9 5 -11 3 -13 0 -14 -64 0 3 -4 5 -5 -64 0 1 -4 2 -4 4 -5 5 -7 5 -10 4 -12 -64 -64 3429 129 -16 -9 12 -8 9 -2 9 -3 6 -4 4 -5 3 -7 2 -64 0 -2 9 -2 -6 -1 -7 -3 -9 -64 0 -3 3 -4 3 -3 4 -3 -6 -4 -7 -3 -8 -2 -7 -3 -6 -64 0 -7 2 -4 2 -4 -6 -5 -7 -3 -9 -64 0 -2 2 3 5 5 4 6 2 6 0 5 -2 1 -4 -64 0 3 4 5 3 -64 0 2 4 4 3 5 1 5 0 4 -2 3 -3 -64 0 3 -3 5 -4 6 -6 6 -9 5 -11 3 -13 0 -14 -64 0 3 -4 5 -5 -64 0 1 -4 2 -4 4 -5 5 -7 5 -10 4 -12 -64 -64 3430 141 -16 -9 12 -8 9 2 5 -1 4 -3 3 -4 2 -5 -1 -5 -4 -4 -7 -3 -9 3 -6 -64 0 -4 -4 -3 -7 -2 -8 -64 0 -1 4 -3 2 -4 -1 -4 -3 -3 -6 -1 -8 -64 0 0 4 1 3 3 2 3 -7 5 -9 8 -6 -64 0 1 4 4 2 4 -6 6 -8 -64 0 2 5 3 4 5 3 6 3 -64 0 5 2 6 3 -64 0 5 2 5 -6 6 -7 7 -7 -64 0 -2 11 -3 10 -3 6 -64 0 -2 10 -3 6 -64 0 -2 11 -1 10 -3 6 -64 0 5 11 4 10 4 6 -64 0 5 10 4 6 -64 0 5 11 6 10 4 6 -64 -64 3431 131 -16 -9 12 -8 9 -4 2 -4 -6 -5 -7 -64 0 -3 2 -3 -6 0 -8 -64 0 -1 3 -2 2 -2 -6 0 -7 1 -8 -64 0 -5 -7 -4 -7 -2 -8 -1 -9 2 -8 -64 0 -4 2 -1 3 4 5 5 3 6 0 6 -3 5 -6 4 -7 2 -8 -64 0 3 4 4 3 5 1 -64 0 2 4 4 2 5 -1 5 -3 4 -6 2 -8 -64 0 -2 11 -3 10 -3 6 -64 0 -2 10 -3 6 -64 0 -2 11 -1 10 -3 6 -64 0 5 11 4 10 4 6 -64 0 5 10 4 6 -64 0 5 11 6 10 4 6 -64 -64 3432 143 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -6 -7 -64 0 -6 4 -4 2 -4 -6 -2 -8 -64 0 -8 2 -5 5 -3 3 -3 -6 -1 -7 0 -8 -64 0 -6 -7 -5 -7 -3 -8 -2 -9 0 -8 3 -6 -64 0 4 5 2 3 3 2 3 -7 5 -9 8 -6 -64 0 4 2 5 3 4 4 3 3 4 2 4 -6 6 -8 -64 0 4 5 6 3 5 2 5 -6 6 -7 7 -7 -64 0 -3 11 -4 10 -4 6 -64 0 -3 10 -4 6 -64 0 -3 11 -2 10 -4 6 -64 0 4 11 3 10 3 6 -64 0 4 10 3 6 -64 0 4 11 5 10 3 6 -64 -64 3501 125 -16 -9 12 -11 11 -6 9 -4 11 -2 12 0 12 1 11 8 -5 9 -6 11 -6 -64 0 -1 11 0 10 7 -6 8 -8 9 -7 7 -6 -64 0 -4 11 -2 11 -1 10 6 -6 7 -8 8 -9 9 -9 11 -6 -64 0 -6 5 -5 6 -3 7 -2 7 -1 6 -64 0 -2 6 -2 5 -64 0 -5 6 -3 6 -2 4 -64 0 -11 -9 -9 -7 -7 -6 -4 -6 -2 -7 -64 0 -8 -7 -4 -7 -3 -8 -64 0 -11 -9 -8 -8 -5 -8 -4 -9 -2 -7 -64 0 0 8 -6 -6 -64 0 -4 -1 4 -1 -64 -64 3502 225 -16 -9 12 -12 12 -10 10 -8 12 -5 12 -3 11 -1 12 -64 0 -7 11 -4 11 -64 0 -10 10 -8 11 -6 10 -3 10 -1 12 -64 0 -5 7 -6 6 -7 4 -7 3 -9 3 -10 2 -10 0 -9 1 -7 1 -7 -5 -64 0 -6 5 -6 -3 -64 0 -9 2 -6 2 -64 0 -5 7 -5 -2 -6 -4 -7 -5 -64 0 0 9 -1 8 -2 6 -2 -3 -64 0 -1 7 -1 -1 -64 0 0 9 0 0 -1 -2 -2 -3 -64 0 0 9 6 12 8 11 9 9 9 7 7 5 3 3 -64 0 6 11 8 9 8 7 -64 0 4 11 6 10 7 9 7 6 5 4 -64 0 5 4 8 2 9 0 9 -6 -64 0 7 2 8 0 8 -5 -64 0 5 4 6 3 7 1 7 -6 -64 0 -8 -9 -5 -7 -2 -6 2 -6 5 -7 -64 0 -6 -8 -3 -7 2 -7 4 -8 -64 0 -8 -9 -4 -8 1 -8 3 -9 5 -7 7 -6 9 -6 -64 0 3 3 3 -6 -64 0 3 0 7 0 -64 0 3 -3 7 -3 -64 -64 3503 143 -16 -9 12 -13 11 -4 11 -6 10 -8 8 -9 6 -10 3 -10 -1 -9 -4 -8 -6 -5 -8 -2 -9 1 -9 4 -8 6 -7 8 -5 9 -3 -64 0 -8 7 -9 4 -9 -1 -7 -5 -4 -7 -1 -8 2 -8 5 -7 -64 0 -4 11 -6 9 -7 7 -8 4 -8 0 -7 -3 -4 -6 -1 -7 2 -7 5 -6 7 -5 9 -3 -64 0 -2 8 -2 -4 -64 0 -1 8 -1 -2 -64 0 0 9 0 -1 -1 -3 -2 -4 -64 0 -2 8 0 9 3 12 5 11 7 11 8 12 -64 0 2 11 4 10 6 10 -64 0 1 10 3 9 5 9 7 10 8 12 -64 0 5 9 5 -6 -64 -64 3504 149 -16 -9 12 -11 12 -9 12 5 12 7 11 8 9 8 -6 -64 0 -7 11 5 11 7 9 7 -5 -64 0 -9 12 -8 11 -6 10 5 10 6 9 6 -6 -64 0 -3 7 -4 6 -5 4 -5 3 -7 3 -8 2 -8 0 -7 1 -5 1 -5 -4 -64 0 -4 5 -4 -2 -64 0 -7 2 -4 2 -64 0 -3 7 -3 -1 -4 -3 -5 -4 -64 0 -9 -9 -6 -7 -3 -6 1 -6 4 -7 -64 0 -7 -8 -4 -7 1 -7 3 -8 -64 0 -9 -9 -5 -8 0 -8 2 -9 4 -7 6 -6 8 -6 -64 0 0 10 0 -6 -64 0 0 5 2 4 4 4 6 5 -64 0 0 -1 2 0 4 0 6 -1 -64 -64 3505 193 -16 -9 12 -11 11 -9 10 -7 12 -5 12 -3 11 -1 12 -64 0 -6 11 -4 11 -64 0 -9 10 -7 11 -5 10 -3 10 -1 12 -64 0 -4 7 -5 6 -6 4 -6 3 -8 3 -9 2 -9 0 -8 1 -6 1 -6 -5 -64 0 -5 5 -5 -3 -64 0 -8 2 -5 2 -64 0 -4 7 -4 -2 -5 -4 -6 -5 -64 0 -1 5 0 8 1 10 2 11 4 12 6 12 9 11 -64 0 2 10 4 11 6 11 8 10 -64 0 0 8 1 9 3 10 5 10 7 9 9 11 -64 0 -1 -3 0 0 1 2 2 3 4 3 6 2 -64 0 2 2 4 2 5 1 -64 0 0 0 1 1 3 1 4 0 6 2 -64 0 -7 -9 -4 -7 0 -6 5 -6 9 -7 -64 0 -5 -8 -2 -7 5 -7 8 -8 -64 0 -7 -9 -3 -8 4 -8 7 -9 9 -7 -64 0 -1 5 -1 -6 -64 -64 3506 187 -16 -9 12 -12 11 -8 10 -6 12 -3 12 -1 11 1 12 -64 0 -5 11 -2 11 -64 0 -8 10 -6 11 -4 10 -1 10 1 12 -64 0 -2 7 -3 6 -4 4 -4 3 -6 3 -7 2 -7 0 -6 1 -4 1 -4 -4 -64 0 -3 5 -3 -2 -64 0 -6 2 -3 2 -64 0 -2 7 -2 -1 -3 -3 -4 -4 -64 0 1 8 1 -7 0 -8 -1 -8 -5 -6 -7 -6 -9 -7 -11 -9 -64 0 2 8 2 -6 -64 0 2 2 6 2 -64 0 -2 -8 -3 -8 -5 -7 -8 -7 -64 0 3 9 3 3 6 3 -64 0 6 1 3 1 3 -5 2 -7 -2 -9 -4 -9 -6 -8 -8 -8 -11 -9 -64 0 1 8 3 9 6 12 8 11 10 11 11 12 -64 0 5 11 7 10 9 10 -64 0 4 10 6 9 8 9 10 10 11 12 -64 0 6 9 6 -5 -64 -64 3507 179 -16 -9 12 -13 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 3 -9 6 -8 8 -6 9 -4 9 -1 8 1 7 2 5 3 3 3 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 7 -6 8 -5 8 -1 7 1 -64 0 3 -9 5 -8 6 -7 7 -5 7 -1 6 1 5 2 3 3 -64 0 -2 8 -2 -5 -64 0 -1 8 -1 -3 -64 0 0 9 0 -2 -1 -4 -2 -5 -64 0 -2 8 0 9 3 12 5 11 7 11 8 12 -64 0 2 11 4 10 6 10 -64 0 1 10 3 9 5 9 7 10 8 12 -64 0 7 10 3 3 3 -9 -64 0 3 -1 7 -1 -64 0 3 -4 7 -4 -64 -64 3508 229 -16 -9 12 -12 12 -10 10 -8 12 -5 12 -3 11 -1 12 -64 0 -7 11 -4 11 -64 0 -10 10 -8 11 -6 10 -3 10 -1 12 -64 0 -5 7 -6 6 -7 4 -7 3 -9 3 -10 2 -10 0 -9 1 -7 1 -7 -5 -64 0 -6 5 -6 -3 -64 0 -9 2 -6 2 -64 0 -5 7 -5 -2 -6 -4 -7 -5 -64 0 -8 -9 -5 -7 -2 -6 1 -6 3 -7 -64 0 -6 -8 -3 -7 0 -7 2 -8 -64 0 -8 -9 -4 -8 -1 -8 1 -9 3 -7 -64 0 0 9 -1 8 -2 6 -2 -3 -64 0 -1 7 -1 -1 -64 0 0 9 0 0 -1 -2 -2 -3 -64 0 0 9 2 11 4 12 6 12 8 11 -64 0 5 11 6 11 7 10 -64 0 2 11 4 11 6 9 8 11 -64 0 3 3 5 4 7 6 8 5 9 2 9 -2 8 -6 6 -9 -64 0 6 5 7 4 8 2 8 -3 7 -6 -64 0 5 4 6 4 7 2 7 -3 6 -9 -64 0 3 3 3 -7 -64 0 3 0 7 0 -64 0 3 -3 7 -3 -64 -64 3509 139 -16 -9 12 -9 10 -6 10 -4 12 -1 12 2 11 4 12 -64 0 -3 11 1 11 -64 0 -6 10 -4 11 -1 10 2 10 4 12 -64 0 1 7 0 6 -1 4 -1 3 -3 3 -4 2 -4 0 -3 1 -1 1 -1 -4 -64 0 0 5 0 -2 -64 0 -3 2 0 2 -64 0 1 7 1 -1 0 -3 -1 -4 -64 0 7 10 5 8 4 5 4 -6 3 -8 1 -8 -3 -6 -5 -6 -7 -7 -9 -9 -64 0 5 7 5 -5 -64 0 0 -8 -1 -8 -3 -7 -6 -7 -64 0 7 10 6 8 6 -4 5 -6 3 -8 1 -9 -2 -9 -4 -8 -7 -8 -9 -9 -64 -64 3510 135 -16 -9 12 -10 10 -6 10 -4 12 -1 12 2 11 4 12 -64 0 -3 11 1 11 -64 0 -6 10 -4 11 -1 10 2 10 4 12 -64 0 1 7 0 6 -1 4 -1 3 -3 3 -4 2 -4 0 -3 1 -1 1 -1 -4 -64 0 0 5 0 -2 -64 0 -3 2 0 2 -64 0 1 7 1 -1 0 -3 -1 -4 -64 0 7 10 5 8 4 5 4 -6 3 -8 -64 0 5 7 5 -5 -64 0 7 10 6 8 6 -4 5 -6 3 -8 0 -9 -3 -9 -6 -8 -8 -6 -8 -4 -7 -3 -6 -3 -5 -4 -6 -5 -7 -5 -64 0 -8 -4 -5 -4 -64 -64 3511 235 -16 -9 12 -12 12 -10 10 -8 12 -5 12 -3 11 -1 12 -64 0 -7 11 -4 11 -64 0 -10 10 -8 11 -6 10 -3 10 -1 12 -64 0 -5 7 -6 6 -7 4 -7 3 -9 3 -10 2 -10 0 -9 1 -7 1 -7 -5 -64 0 -6 5 -6 -3 -64 0 -9 2 -6 2 -64 0 -5 7 -5 -2 -6 -4 -7 -5 -64 0 -8 -9 -5 -7 -2 -6 1 -6 3 -7 -64 0 -6 -8 -4 -7 0 -7 2 -8 -64 0 -8 -9 -4 -8 -1 -8 1 -9 3 -7 -64 0 0 9 -1 8 -2 6 -2 -3 -64 0 -1 7 -1 -1 -64 0 0 9 0 0 -1 -2 -2 -3 -64 0 0 9 2 11 4 12 6 12 8 11 -64 0 5 11 6 11 7 10 -64 0 2 11 4 11 6 9 8 11 -64 0 3 3 6 6 7 5 9 4 -64 0 5 5 7 4 9 4 -64 0 9 4 7 1 5 -1 3 -3 -64 0 5 -1 7 -2 8 -6 9 -8 10 -8 -64 0 7 -4 8 -8 -64 0 5 -1 6 -2 7 -8 8 -9 9 -9 10 -8 -64 0 3 3 3 -7 -64 -64 3512 175 -16 -9 12 -11 11 -9 10 -7 12 -4 12 -2 11 0 12 -64 0 -6 11 -3 11 -64 0 -9 10 -7 11 -5 10 -2 10 0 12 -64 0 -4 7 -5 6 -6 4 -6 3 -8 3 -9 2 -9 0 -8 1 -6 1 -6 -5 -64 0 -5 5 -5 -3 -64 0 -8 2 -5 2 -64 0 -4 7 -4 -2 -5 -4 -6 -5 -64 0 -7 -9 -4 -7 0 -6 5 -6 9 -7 -64 0 -5 -8 -2 -7 5 -7 8 -8 -64 0 -7 -9 -3 -8 4 -8 7 -9 9 -7 -64 0 1 9 0 8 -1 6 -1 -3 -64 0 0 7 0 -1 -64 0 1 9 1 0 0 -2 -1 -3 -64 0 1 9 3 11 5 12 7 12 9 11 -64 0 6 11 7 11 8 10 -64 0 3 11 5 11 7 9 9 11 -64 0 5 11 5 -6 -64 -64 3513 219 -16 -9 12 -14 14 -6 8 -7 7 -8 5 -8 3 -10 3 -11 2 -11 0 -10 1 -8 1 -8 -3 -64 0 -7 6 -7 -1 -64 0 -10 2 -7 2 -64 0 -6 8 -6 0 -7 -2 -8 -3 -64 0 -13 -9 -11 -7 -9 -6 -7 -6 -5 -7 -4 -7 -3 -6 -64 0 -10 -7 -7 -7 -5 -8 -64 0 -13 -9 -11 -8 -8 -8 -6 -9 -5 -9 -4 -8 -3 -6 -64 0 -6 8 -2 12 2 8 2 -5 3 -7 4 -7 -64 0 -2 11 1 8 1 -6 0 -7 1 -8 2 -7 1 -6 -64 0 -2 2 1 2 -64 0 -4 10 -3 10 0 7 0 3 -3 3 -64 0 -3 1 0 1 0 -6 -1 -7 1 -9 4 -7 5 -6 -64 0 2 8 6 12 10 8 10 -5 11 -7 12 -7 -64 0 6 11 9 8 9 -6 11 -8 -64 0 6 2 9 2 -64 0 4 10 5 10 8 7 8 3 5 3 -64 0 5 1 8 1 8 -7 10 -9 12 -7 -64 0 -3 10 -3 -6 -64 0 5 10 5 -6 -64 -64 3514 173 -16 -9 12 -13 12 -11 9 -9 11 -7 12 -5 12 -3 11 -1 8 4 -3 6 -6 7 -7 -64 0 -5 11 -3 9 -2 7 4 -5 7 -8 -64 0 -9 11 -7 11 -5 10 -3 7 2 -4 4 -7 5 -8 7 -9 -64 0 4 10 6 9 8 9 10 10 11 12 -64 0 5 11 7 10 9 10 -64 0 4 10 6 12 8 11 10 11 11 12 -64 0 -7 3 -9 3 -10 2 -10 0 -9 1 -7 1 -64 0 -9 2 -7 2 -64 0 -11 -9 -9 -7 -7 -6 -4 -6 -2 -7 -64 0 -8 -7 -5 -7 -3 -8 -64 0 -11 -9 -8 -8 -5 -8 -4 -9 -2 -7 -64 0 -7 11 -7 -6 -64 0 7 9 7 -9 -64 0 0 6 1 5 3 4 5 4 7 5 -64 0 -7 -2 -5 -1 -1 -1 1 -2 -64 -64 3515 163 -16 -9 12 -13 13 -4 12 -6 11 -8 9 -9 7 -10 4 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 4 9 7 8 9 6 11 4 12 3 11 0 9 -3 8 -64 0 -8 8 -9 5 -9 -1 -8 -4 -64 0 -4 12 -6 10 -7 8 -8 5 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 8 -4 9 -1 9 5 7 9 6 10 -64 0 4 -8 6 -6 7 -4 8 -1 8 5 7 7 5 10 3 11 -64 0 -3 8 -3 -5 -64 0 -2 8 -2 -3 -64 0 -1 8 -1 -2 -2 -4 -3 -5 -64 0 3 11 3 -8 -64 0 3 5 5 4 6 4 8 5 -64 0 3 -1 5 0 6 0 8 -1 -64 -64 3516 145 -16 -9 12 -10 12 -7 12 -6 11 -5 9 -5 3 -7 3 -8 2 -8 0 -7 1 -5 1 -5 -7 -8 -9 -5 -8 -5 -16 -3 -14 -64 0 -5 10 -4 8 -4 -14 -64 0 -7 2 -4 2 -64 0 -7 12 -5 11 -4 10 -3 8 -3 -14 -64 0 -3 7 0 9 4 12 8 8 8 -6 -64 0 4 11 7 8 7 -6 -64 0 2 10 3 10 6 7 6 -7 -64 0 0 -6 3 -6 6 -7 -64 0 1 -7 3 -7 5 -8 -64 0 0 -8 2 -8 4 -9 6 -7 8 -6 -64 0 0 9 0 -13 -64 0 0 5 2 4 4 4 6 5 -64 0 0 -1 2 0 4 0 6 -1 -64 -64 3517 203 -16 -9 12 -13 13 -4 12 -6 11 -8 9 -9 7 -10 4 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -2 -9 2 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 4 9 7 8 9 6 11 4 12 3 11 0 9 -3 8 -64 0 -8 8 -9 5 -9 -1 -8 -4 -64 0 -4 12 -6 10 -7 8 -8 5 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 8 -4 9 -1 9 5 7 9 6 10 -64 0 4 -8 6 -6 7 -4 8 -1 8 5 7 7 5 10 3 11 -64 0 -3 8 -3 -5 -64 0 -2 8 -2 -3 -64 0 -1 8 -1 -2 -2 -4 -3 -5 -64 0 3 11 3 -8 -64 0 3 5 5 4 6 4 8 5 -64 0 3 -1 5 0 6 0 8 -1 -64 0 -2 -9 -1 -8 0 -8 2 -9 6 -14 8 -15 9 -15 -64 0 2 -10 4 -13 6 -15 7 -15 -64 0 0 -8 1 -9 4 -15 6 -16 8 -16 9 -15 -64 -64 3518 221 -16 -9 12 -12 12 -10 10 -8 12 -5 12 -3 11 -1 12 -64 0 -7 11 -4 11 -64 0 -10 10 -8 11 -6 10 -3 10 -1 12 -64 0 -5 7 -6 6 -7 4 -7 3 -9 3 -10 2 -10 0 -9 1 -7 1 -7 -5 -64 0 -6 5 -6 -3 -64 0 -9 2 -6 2 -64 0 -5 7 -5 -2 -6 -4 -7 -5 -64 0 -8 -9 -5 -7 -2 -6 0 -6 3 -7 -64 0 -6 -8 -4 -7 0 -7 2 -8 -64 0 -8 -9 -4 -8 -1 -8 1 -9 3 -7 -64 0 0 9 -1 8 -2 6 -2 -3 -64 0 -1 7 -1 -1 -64 0 0 9 0 0 -1 -2 -2 -3 -64 0 0 9 3 11 5 12 7 11 8 9 8 6 7 4 6 3 2 1 0 0 -64 0 5 11 6 11 7 9 7 5 6 4 -64 0 3 11 5 10 6 8 6 5 5 3 2 1 -64 0 2 1 4 0 5 -1 8 -6 9 -7 10 -7 -64 0 5 -2 7 -6 9 -8 -64 0 2 1 4 -1 6 -7 8 -9 10 -7 -64 -64 3519 193 -16 -9 12 -11 12 3 9 2 10 0 11 -3 12 -64 0 4 10 2 11 -64 0 5 11 1 12 -3 12 -6 11 -7 10 -8 8 -7 6 -6 5 -3 4 5 4 7 3 8 2 8 0 7 -3 -64 0 -7 7 -6 6 -3 5 6 5 8 4 9 3 9 1 8 -1 -64 0 -7 10 -7 8 -6 7 -3 6 7 6 9 5 10 3 10 1 7 -3 3 -9 -64 0 -9 3 -8 2 -6 1 3 1 4 0 4 -1 3 -3 -64 0 -8 1 -6 0 2 0 3 -1 -64 0 -9 3 -9 2 -8 0 -6 -1 1 -1 3 -2 3 -3 -64 0 -9 -9 -6 -7 -2 -6 1 -6 4 -7 -64 0 -7 -8 -4 -7 0 -7 3 -8 -64 0 -9 -9 -5 -8 0 -8 3 -9 -64 0 5 11 3 9 1 6 -64 0 0 4 -2 1 -64 0 -3 -1 -5 -3 -7 -4 -8 -4 -8 -3 -7 -4 -64 -64 3520 147 -16 -9 12 -13 11 -8 8 -9 6 -10 3 -10 -1 -9 -4 -7 -7 -5 -8 -2 -9 1 -9 4 -8 6 -7 8 -5 9 -3 -64 0 -9 -1 -8 -4 -6 -6 -4 -7 -1 -8 2 -8 5 -7 -64 0 -8 8 -9 5 -9 1 -8 -2 -6 -5 -4 -6 -1 -7 2 -7 5 -6 7 -5 9 -3 -64 0 -10 9 -9 11 -7 12 -3 12 3 11 7 11 9 12 -64 0 -2 11 2 10 6 10 -64 0 -10 9 -9 10 -7 11 -4 11 2 9 5 9 7 10 9 12 -64 0 1 9 0 8 -2 7 -2 -4 -64 0 -1 7 -1 -2 -64 0 0 8 0 -1 -1 -3 -2 -4 -64 0 5 9 5 -6 -64 -64 3521 183 -16 -9 12 -12 12 -10 10 -8 12 -6 12 -3 11 -1 12 -64 0 -7 11 -4 11 -64 0 -10 10 -8 11 -5 10 -3 10 -1 12 -64 0 -7 8 -8 6 -9 3 -9 -1 -8 -4 -7 -6 -5 -8 -2 -9 1 -9 4 -8 6 -7 8 -9 10 -7 -64 0 -8 -1 -7 -4 -4 -7 -1 -8 2 -8 -64 0 -7 8 -8 4 -8 1 -7 -2 -6 -4 -4 -6 -1 -7 3 -7 6 -6 -64 0 3 9 -1 8 -2 6 -2 -4 -64 0 -1 7 -1 -2 -64 0 0 8 0 -1 -1 -3 -2 -4 -64 0 3 9 5 10 7 12 8 11 10 10 8 9 8 -5 9 -7 10 -7 -64 0 7 9 8 10 7 11 6 10 7 9 7 -6 9 -8 -64 0 5 10 6 9 6 -6 -64 0 3 9 3 -7 -64 0 3 4 6 4 -64 0 3 0 6 0 -64 -64 3522 149 -16 -9 12 -11 12 -8 12 -7 11 -6 9 -6 3 -8 3 -9 2 -9 0 -8 1 -6 1 -6 -6 -8 -7 -64 0 -6 10 -5 8 -5 -6 -64 0 -8 2 -5 2 -64 0 -4 -7 -1 -7 1 -8 -64 0 -8 12 -6 11 -5 10 -4 8 -4 -6 0 -6 3 -7 -64 0 -8 -7 -5 -7 -2 -8 0 -9 3 -7 6 -6 8 -6 -64 0 0 8 3 9 5 10 7 12 8 11 10 10 8 9 8 -6 -64 0 7 9 8 10 7 11 6 10 7 9 7 -5 -64 0 5 10 6 9 6 -6 -64 0 0 8 0 -6 -64 0 0 5 2 4 4 4 6 5 -64 0 0 -1 2 0 4 0 6 -1 -64 -64 3523 195 -16 -9 12 -13 14 -10 12 -9 11 -8 9 -8 3 -10 3 -11 2 -11 0 -10 1 -8 1 -8 -6 -10 -7 -64 0 -8 10 -7 8 -7 -6 -64 0 -10 2 -7 2 -64 0 -6 -7 -4 -7 -2 -8 -64 0 -10 12 -8 11 -7 10 -6 8 -6 -6 -3 -6 -1 -7 -64 0 -10 -7 -7 -7 -4 -8 -3 -9 -1 -7 2 -6 4 -7 5 -9 7 -7 10 -6 -64 0 -3 10 0 12 2 10 2 -6 5 -6 7 -7 -64 0 0 11 1 10 1 -6 -64 0 -3 10 -1 10 0 9 0 -6 -1 -7 -64 0 5 -7 6 -8 -64 0 5 10 8 12 10 10 10 -6 -64 0 8 11 9 10 9 -6 -64 0 5 10 7 10 8 9 8 -6 7 -7 -64 0 -3 10 -3 -6 -64 0 5 10 5 -6 -64 0 -3 4 0 4 -64 0 -3 0 0 0 -64 0 5 4 8 4 -64 0 5 0 8 0 -64 -64 3524 135 -16 -9 12 -11 11 -10 9 -8 11 -6 12 -4 12 -3 11 5 -7 6 -8 8 -8 -64 0 -5 11 -4 10 4 -7 5 -8 -64 0 -8 11 -6 11 -5 10 3 -8 4 -9 6 -9 8 -8 10 -6 -64 0 5 12 7 11 9 11 10 12 -64 0 5 11 6 10 8 10 -64 0 4 10 5 9 7 9 9 10 10 12 -64 0 -10 -9 -9 -7 -7 -6 -5 -6 -4 -7 -64 0 -8 -7 -6 -7 -5 -8 -64 0 -10 -9 -9 -8 -7 -8 -5 -9 -64 0 5 12 1 3 -64 0 -1 0 -5 -9 -64 0 -6 2 -2 2 -64 0 1 2 6 2 -64 -64 3525 177 -16 -9 12 -11 12 -8 12 -7 11 -6 9 -6 3 -8 3 -9 2 -9 0 -8 1 -6 1 -6 -6 -8 -7 -64 0 -6 10 -5 8 -5 -6 -64 0 -8 2 -5 2 -64 0 -4 -7 -1 -7 1 -8 -64 0 -8 12 -6 11 -5 10 -4 8 -4 -6 0 -6 3 -7 -64 0 -8 -7 -5 -7 -2 -8 0 -9 3 -7 6 -6 -64 0 0 8 3 9 5 10 7 12 8 11 10 10 8 9 8 -12 7 -14 5 -16 3 -15 -1 -14 -6 -14 -64 0 7 9 8 10 7 11 6 10 7 9 7 -7 -64 0 5 10 6 9 6 -6 8 -9 -64 0 6 -15 4 -14 1 -14 -64 0 7 -14 4 -13 -2 -13 -6 -14 -64 0 0 8 0 -6 -64 0 0 5 2 4 4 4 6 5 -64 0 0 -1 2 0 4 0 6 -1 -64 -64 3526 119 -16 -9 12 -10 10 6 11 5 9 0 3 -3 -1 -5 -5 -8 -9 -64 0 4 7 -4 -4 -64 0 8 12 5 8 3 4 0 0 -5 -6 -6 -8 -64 0 -8 10 -6 12 -3 11 3 11 8 12 -64 0 -7 11 -3 10 1 10 5 11 -64 0 -8 10 -4 9 0 9 4 10 6 11 -64 0 -6 -8 -4 -7 0 -6 4 -6 8 -7 -64 0 -5 -8 -1 -7 3 -7 7 -8 -64 0 -8 -9 -3 -8 3 -8 6 -9 8 -7 -64 0 -5 2 -1 2 -64 0 2 2 6 2 -64 -64 3601 111 -16 -9 12 -8 9 -2 0 -4 -2 -5 -4 -5 -6 -4 -8 -2 -9 0 -7 3 -6 -64 0 -5 -4 -4 -6 -3 -7 -1 -8 -64 0 -4 -2 -4 -4 -3 -6 -1 -7 0 -7 -64 0 -4 2 -2 2 1 3 3 4 4 5 6 3 5 2 5 -6 6 -7 7 -7 -64 0 -3 4 -4 3 -1 3 -64 0 2 3 5 3 4 4 4 -7 5 -8 -64 0 -5 3 -3 5 -2 4 0 3 3 2 3 -7 5 -9 7 -7 -64 0 -5 3 0 -2 -64 -64 3602 93 -16 -9 12 -9 9 -6 10 -5 8 -5 -6 -7 -7 -64 0 -4 8 -5 10 -4 11 -4 -6 -1 -8 -64 0 -6 10 -3 12 -3 -6 -1 -7 0 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 3 -7 5 -7 -64 0 -3 2 0 3 2 4 3 5 4 4 6 3 7 3 5 2 5 -7 -64 0 2 4 4 3 4 -6 -64 0 0 3 1 3 3 2 3 -7 -64 -64 3603 75 -16 -9 12 -8 6 -4 3 -4 -6 -6 -7 -5 -7 -3 -8 -2 -9 -64 0 -3 3 -3 -7 -1 -8 -64 0 -2 3 -2 -6 0 -7 1 -7 -1 -8 -2 -9 -64 0 -4 3 0 4 2 5 3 4 5 3 6 3 -64 0 1 4 2 3 4 3 -64 0 -2 3 0 4 2 2 4 2 6 3 -64 -64 3604 87 -16 -9 12 -9 8 0 5 -2 4 -5 3 -5 -6 -7 -7 -64 0 -4 3 -4 -6 -1 -8 -64 0 0 5 -3 3 -3 -6 -1 -7 0 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 3 -7 5 -7 -64 0 -5 10 -2 12 -1 9 5 3 5 -7 -64 0 -2 9 -4 10 -3 11 -2 9 4 3 4 -6 -64 0 -5 10 3 2 3 -7 -64 -64 3605 69 -16 -9 12 -8 6 -4 3 -4 -6 -6 -7 -5 -7 -3 -8 -2 -9 -64 0 -3 3 -3 -7 -1 -8 -64 0 -2 3 -2 -6 0 -7 1 -7 -1 -8 -2 -9 -64 0 -4 3 0 4 2 5 5 1 3 0 -2 -3 -64 0 1 4 4 1 -64 0 -2 3 0 4 3 0 -64 -64 3606 87 -16 -9 12 -8 5 -4 10 -4 -6 -6 -7 -5 -7 -3 -8 -2 -9 -64 0 -3 10 -3 -7 -1 -8 -64 0 -2 10 -2 -6 0 -7 1 -7 -1 -8 -2 -9 -64 0 -4 10 -1 11 1 12 2 11 4 10 5 10 -64 0 0 11 1 10 3 10 -64 0 -2 10 -1 11 1 9 3 9 5 10 -64 0 -7 5 -4 5 -64 0 -2 5 2 5 -64 -64 3607 117 -16 -9 12 -9 9 -5 3 -5 -6 -7 -7 -6 -7 -4 -8 -3 -9 -2 -8 0 -7 3 -6 -64 0 -4 2 -4 -7 -2 -8 -64 0 -3 3 -3 -6 -1 -7 0 -7 -64 0 -5 3 -3 3 0 4 2 5 3 4 5 3 7 3 5 2 5 -10 4 -13 2 -15 0 -16 -1 -15 -3 -14 -5 -14 -64 0 1 4 4 2 4 -10 -64 0 1 -15 -1 -14 -2 -14 -64 0 0 4 1 3 3 2 3 -8 4 -11 4 -13 -64 0 2 -15 1 -14 -1 -13 -3 -13 -5 -14 -64 -64 3608 99 -16 -9 12 -9 9 -6 10 -5 8 -5 -6 -7 -7 -6 -7 -4 -8 -3 -9 -64 0 -4 8 -5 10 -4 11 -4 -7 -2 -8 -64 0 -6 10 -3 12 -3 -6 -1 -7 -3 -9 -64 0 -3 2 0 3 2 4 3 5 4 4 6 3 7 3 5 2 5 -7 3 -9 2 -11 -64 0 2 4 4 3 4 -7 3 -9 -64 0 0 3 1 3 3 2 3 -7 2 -11 2 -14 3 -16 4 -16 2 -14 -64 -64 3609 75 -16 -9 12 -5 5 0 12 -2 10 0 9 2 10 0 12 -64 0 0 11 -1 10 1 10 0 11 -64 0 0 5 -1 4 -3 3 -1 2 -1 -7 1 -9 3 -7 -64 0 0 2 1 3 0 4 -1 3 0 2 0 -7 1 -8 -64 0 0 5 1 4 3 3 1 2 1 -6 2 -7 3 -7 -64 -64 3610 83 -16 -9 12 -5 5 0 12 -2 10 0 9 2 10 0 12 -64 0 0 11 -1 10 1 10 0 11 -64 0 0 5 -1 4 -3 3 -1 2 -1 -7 1 -9 2 -11 -64 0 0 2 1 3 0 4 -1 3 0 2 0 -7 1 -9 -64 0 0 5 1 4 3 3 1 2 1 -7 2 -11 2 -14 0 -16 -2 -16 -2 -15 0 -16 -64 -64 3611 105 -16 -9 12 -9 8 -6 10 -5 8 -5 -6 -7 -7 -6 -7 -4 -8 -3 -9 -64 0 -4 8 -5 10 -4 11 -4 -7 -2 -8 -64 0 -6 10 -3 12 -3 -6 -1 -7 -3 -9 -64 0 -3 2 0 4 2 5 4 2 1 0 -3 -3 -64 0 1 4 3 2 -64 0 0 4 2 1 -64 0 1 0 2 -1 4 -6 5 -7 6 -7 -64 0 1 -1 2 -2 3 -7 4 -8 -64 0 0 -1 1 -2 2 -7 4 -9 6 -7 -64 -64 3612 49 -16 -9 12 -5 5 -2 10 -1 8 -1 -6 -3 -7 -2 -7 0 -8 1 -9 -64 0 0 8 -1 10 0 11 0 -7 2 -8 -64 0 -2 10 1 12 1 -6 3 -7 4 -7 2 -8 1 -9 -64 -64 3613 139 -16 -9 12 -13 13 -11 3 -10 3 -9 2 -9 -6 -11 -7 -10 -7 -8 -8 -7 -9 -64 0 -9 4 -8 3 -8 -7 -6 -8 -64 0 -11 3 -9 5 -7 3 -7 -6 -5 -7 -7 -9 -64 0 -7 2 -4 3 -2 4 -1 5 1 3 1 -6 3 -7 1 -9 -64 0 -2 4 0 3 0 -7 2 -8 -64 0 -4 3 -3 3 -1 2 -1 -6 -2 -7 0 -8 1 -9 -64 0 1 2 4 3 6 4 7 5 8 4 10 3 11 3 9 2 9 -6 10 -7 11 -7 -64 0 6 4 8 3 8 -7 9 -8 -64 0 4 3 5 3 7 2 7 -7 9 -9 11 -7 -64 -64 3614 95 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -7 -7 -6 -7 -4 -8 -3 -9 -64 0 -5 4 -4 3 -4 -7 -2 -8 -64 0 -7 3 -5 5 -3 3 -3 -6 -1 -7 -3 -9 -64 0 -3 2 0 3 2 4 3 5 4 4 6 3 7 3 5 2 5 -6 6 -7 7 -7 -64 0 2 4 4 3 4 -7 5 -8 -64 0 0 3 1 3 3 2 3 -7 5 -9 7 -7 -64 -64 3615 85 -16 -9 12 -9 9 -5 3 -5 -6 -7 -7 -64 0 -4 2 -4 -6 -1 -8 -64 0 -3 3 -3 -6 -1 -7 0 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 3 -7 5 -7 -64 0 -5 3 -3 3 0 4 2 5 3 4 5 3 7 3 5 2 5 -7 -64 0 1 4 4 2 4 -6 -64 0 0 4 1 3 3 2 3 -7 -64 -64 3616 113 -16 -9 12 -9 9 -6 5 -5 3 -5 -6 -7 -7 -5 -7 -5 -16 -64 0 -5 4 -4 3 -4 -15 -3 -14 -4 -12 -64 0 -4 -7 -3 -7 -1 -8 -64 0 -6 5 -4 4 -3 3 -3 -6 -1 -7 0 -8 -64 0 -3 -8 -2 -9 0 -8 3 -7 5 -7 -64 0 -3 -8 -3 -12 -2 -14 -5 -16 -64 0 -3 2 0 3 2 4 3 5 4 4 6 3 7 3 5 2 5 -7 -64 0 2 4 4 3 4 -6 -64 0 0 3 1 3 3 2 3 -7 -64 -64 3617 93 -16 -9 12 -9 9 -5 3 -5 -6 -7 -7 -64 0 -4 2 -4 -7 -2 -8 -64 0 -3 3 -3 -6 -1 -7 0 -7 -64 0 -7 -7 -6 -7 -4 -8 -3 -9 -2 -8 0 -7 3 -6 -64 0 -5 3 -3 3 0 4 2 5 3 4 5 3 7 3 5 2 5 -16 -64 0 1 4 4 2 4 -15 3 -14 4 -12 -64 0 0 4 1 3 3 2 3 -12 2 -14 5 -16 -64 -64 3618 81 -16 -9 12 -8 6 -6 3 -5 3 -4 2 -4 -6 -6 -7 -5 -7 -3 -8 -2 -9 -64 0 -5 4 -3 3 -3 -7 -1 -8 -64 0 -6 3 -4 5 -2 3 -2 -6 0 -7 1 -7 -1 -8 -2 -9 -64 0 -2 3 2 5 3 4 5 3 6 3 -64 0 1 4 2 3 4 3 -64 0 0 4 2 2 4 2 6 3 -64 -64 3619 123 -16 -9 12 -8 8 -5 3 -5 -1 -3 -2 3 -2 5 -3 5 -7 -64 0 -4 3 -4 -1 -64 0 4 -3 4 -7 -64 0 -2 4 -3 3 -3 -1 -1 -2 -64 0 1 -2 3 -3 3 -7 2 -8 -64 0 -5 3 -2 4 0 5 2 4 4 4 5 5 -64 0 -1 4 1 4 -64 0 -2 4 0 3 2 3 4 4 -64 0 5 -7 2 -8 0 -9 -2 -8 -4 -8 -6 -9 -64 0 1 -8 -1 -8 -64 0 2 -8 0 -7 -3 -7 -6 -9 -64 0 5 5 4 3 2 0 -3 -5 -6 -9 -64 -64 3620 61 -16 -9 12 -5 5 -2 10 -1 8 -1 -6 -3 -7 -2 -7 0 -8 1 -9 -64 0 0 8 -1 10 0 11 0 -7 2 -8 -64 0 -2 10 1 12 1 -6 3 -7 4 -7 2 -8 1 -9 -64 0 -4 5 -1 5 -64 0 1 5 4 5 -64 -64 3621 99 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -7 -7 -64 0 -6 4 -4 3 -4 -7 -2 -8 -64 0 -7 3 -5 5 -3 3 -3 -6 -1 -7 0 -7 -64 0 -7 -7 -6 -7 -4 -8 -3 -9 -2 -8 0 -7 3 -6 -64 0 3 5 4 4 6 3 7 3 5 2 5 -6 6 -7 7 -7 -64 0 2 4 4 3 4 -7 5 -8 -64 0 3 5 1 3 3 2 3 -7 5 -9 7 -7 -64 -64 3622 77 -16 -9 12 -9 9 -6 5 -5 3 -5 -6 -2 -9 0 -7 3 -6 5 -6 -64 0 -5 4 -4 3 -4 -6 -1 -8 -64 0 -6 5 -4 4 -3 3 -3 -5 -2 -6 0 -7 -64 0 3 5 4 4 6 3 7 3 5 2 5 -6 -64 0 2 4 4 3 4 -5 -64 0 3 5 1 3 3 2 3 -6 -64 -64 3623 119 -16 -9 12 -13 13 -10 5 -9 3 -9 -6 -6 -9 -4 -7 -1 -6 -64 0 -9 4 -8 3 -8 -6 -5 -8 -64 0 -10 5 -8 4 -7 3 -7 -5 -6 -6 -4 -7 -64 0 -1 5 -3 3 -1 2 -1 -6 2 -9 4 -7 7 -6 9 -6 -64 0 -2 4 0 3 0 -6 3 -8 -64 0 -1 5 0 4 2 3 1 2 1 -5 2 -6 4 -7 -64 0 7 5 8 4 10 3 11 3 9 2 9 -6 -64 0 6 4 8 3 8 -5 -64 0 7 5 5 3 7 2 7 -6 -64 -64 3624 123 -16 -9 12 -10 9 -7 3 -6 3 -4 2 -3 1 1 -7 2 -8 4 -9 6 -7 -64 0 -5 4 -3 3 2 -7 4 -8 -64 0 -7 3 -5 5 -3 4 -2 3 2 -5 3 -6 5 -7 6 -7 -64 0 0 -1 3 5 4 4 6 4 7 5 -64 0 3 4 4 3 5 3 -64 0 2 3 4 2 6 3 7 5 -64 0 -1 -3 -4 -9 -5 -8 -7 -8 -8 -9 -64 0 -4 -8 -5 -7 -6 -7 -64 0 -3 -7 -5 -6 -7 -7 -8 -9 -64 0 -5 -2 -2 -2 -64 0 1 -2 4 -2 -64 -64 3625 125 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -7 -7 -64 0 -6 4 -4 3 -4 -7 -2 -8 -64 0 -7 3 -5 5 -3 3 -3 -6 -1 -7 0 -7 -64 0 -7 -7 -6 -7 -4 -8 -3 -9 -2 -8 0 -7 3 -6 -64 0 3 5 4 4 6 3 7 3 5 2 5 -10 4 -13 2 -15 0 -16 -1 -15 -3 -14 -5 -14 -64 0 2 4 4 3 4 -10 -64 0 1 -15 -1 -14 -2 -14 -64 0 3 5 1 3 3 2 3 -8 4 -11 4 -13 -64 0 2 -15 1 -14 -1 -13 -3 -13 -5 -14 -64 -64 3626 81 -16 -9 12 -9 9 6 5 -6 -9 -64 0 -6 3 -4 2 -1 2 2 3 6 5 -64 0 -5 4 -3 3 1 3 -64 0 -6 3 -4 5 -2 4 2 4 6 5 -64 0 -6 -9 -2 -7 1 -6 4 -6 6 -7 -64 0 -1 -7 3 -7 5 -8 -64 0 -6 -9 -2 -8 2 -8 4 -9 6 -7 -64 0 -4 -2 4 -2 -64 -64 3697 9 -16 -9 12 0 0 -64 0 -64 -64 3698 9 -16 -9 12 -4 4 -64 0 -64 -64 3699 9 -16 -9 12 -8 8 -64 0 -64 -64 3700 89 -16 -9 12 -10 10 -6 10 -6 -6 -8 -7 -64 0 -5 9 -5 -6 -2 -8 -64 0 -4 10 -4 -6 -2 -7 -1 -8 -64 0 -6 10 -4 10 1 11 3 12 -64 0 1 11 2 10 4 9 4 -7 -64 0 2 11 5 9 5 -6 -64 0 3 12 4 11 6 10 8 10 6 9 6 -7 -64 0 -8 -7 -6 -7 -4 -8 -3 -9 -1 -8 4 -7 6 -7 -64 -64 3701 59 -16 -9 12 -10 10 -3 10 -2 9 -1 7 -1 -6 -3 -7 -64 0 -1 9 -2 10 -1 11 0 9 0 -7 2 -8 -64 0 -3 10 0 12 1 10 1 -6 3 -7 4 -7 -64 0 -3 -7 -2 -7 0 -8 1 -9 2 -8 4 -7 -64 -64 3702 101 -16 -9 12 -10 10 -6 10 -4 10 -2 11 -1 12 1 11 4 10 6 10 -64 0 -2 10 0 11 -64 0 -6 10 -4 9 -2 9 0 10 1 11 -64 0 4 10 4 2 -64 0 5 9 5 3 -64 0 6 10 6 2 -1 2 -4 1 -6 -1 -7 -4 -7 -9 -64 0 -7 -9 -3 -7 1 -6 4 -6 8 -7 -64 0 -4 -8 -1 -7 4 -7 7 -8 -64 0 -7 -9 -2 -8 3 -8 6 -9 8 -7 -64 -64 3703 119 -16 -9 12 -10 10 -6 10 -5 10 -3 11 -2 12 0 11 4 10 6 10 -64 0 -3 10 -1 11 -64 0 -6 10 -4 9 -2 9 0 11 -64 0 4 10 4 3 -64 0 5 9 5 4 -64 0 6 10 6 3 4 3 1 2 -1 1 -64 0 -1 2 1 1 4 0 6 0 6 -7 -64 0 5 -1 5 -6 -64 0 4 0 4 -7 -64 0 -7 -7 -5 -6 -3 -6 -1 -7 0 -8 -64 0 -3 -7 -1 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 4 -7 6 -7 -64 -64 3704 87 -16 -9 12 -10 10 3 12 -7 2 -7 -3 2 -3 -64 0 4 -3 8 -3 9 -4 9 -2 8 -3 -64 0 -6 2 -6 -2 -64 0 -5 4 -5 -3 -64 0 2 11 2 -6 0 -7 -64 0 3 8 4 10 3 11 3 -7 5 -8 -64 0 3 12 5 10 4 8 4 -6 6 -7 7 -7 -64 0 0 -7 1 -7 3 -8 4 -9 5 -8 7 -7 -64 -64 3705 111 -16 -9 12 -10 10 -6 12 -6 3 -64 0 -6 12 6 12 -64 0 -5 11 4 11 -64 0 -6 10 3 10 5 11 6 12 -64 0 4 6 3 5 1 4 -3 3 -6 3 -64 0 1 4 2 4 4 3 4 -7 -64 0 3 5 5 4 5 -6 -64 0 4 6 5 5 7 4 8 4 6 3 6 -7 -64 0 -7 -7 -5 -6 -3 -6 -1 -7 0 -8 -64 0 -3 -7 -1 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 4 -7 6 -7 -64 -64 3706 123 -16 -9 12 -10 10 -6 10 -6 -6 -8 -7 -64 0 -5 9 -5 -6 -2 -8 -64 0 -4 10 -4 -6 -2 -7 -1 -8 -64 0 -6 10 -4 10 0 11 2 12 3 11 5 10 6 10 -64 0 1 11 3 10 -64 0 0 11 2 9 4 9 6 10 -64 0 -4 2 -3 2 1 3 3 4 4 5 -64 0 1 3 2 3 4 2 4 -7 -64 0 3 4 5 2 5 -6 -64 0 4 5 5 4 7 3 8 3 6 2 6 -7 -64 0 -8 -7 -6 -7 -4 -8 -3 -9 -1 -8 4 -7 6 -7 -64 -64 3707 81 -16 -9 12 -10 10 -7 10 -5 12 -2 11 3 11 8 12 -64 0 -6 11 -3 10 2 10 5 11 -64 0 -7 10 -3 9 0 9 4 10 8 12 -64 0 8 12 7 10 5 7 1 3 -1 0 -2 -3 -2 -6 -1 -9 -64 0 0 1 -1 -2 -1 -5 0 -8 -64 0 3 5 1 2 0 -1 0 -4 1 -7 -1 -9 -64 -64 3708 147 -16 -9 12 -10 10 -6 9 -6 3 -64 0 -5 8 -5 4 -64 0 -4 9 -4 3 -64 0 -6 9 -4 9 1 10 3 11 4 12 -64 0 1 10 2 10 4 9 4 3 -64 0 3 11 5 10 5 4 -64 0 4 12 5 11 7 10 8 10 6 9 6 3 -64 0 -6 3 -4 3 4 0 6 0 -64 0 6 3 4 3 -4 0 -6 0 -64 0 -6 0 -6 -6 -8 -7 -64 0 -5 -1 -5 -6 -2 -8 -64 0 -4 0 -4 -6 -2 -7 -1 -8 -64 0 4 0 4 -7 -64 0 5 -1 5 -6 -64 0 6 0 6 -7 -64 0 -8 -7 -6 -7 -4 -8 -3 -9 -1 -8 4 -7 6 -7 -64 -64 3709 125 -16 -9 12 -10 10 -6 10 -6 1 -8 0 -64 0 -5 9 -5 0 -3 -1 -64 0 -4 10 -4 1 -2 0 -1 0 -64 0 -6 10 -4 10 1 11 3 12 -64 0 1 11 2 10 4 9 4 -7 -64 0 2 11 5 9 5 -6 -64 0 3 12 4 11 6 10 8 10 6 9 6 -7 -64 0 -8 0 -7 0 -5 -1 -4 -2 -3 -1 -1 0 3 1 4 1 -64 0 -7 -7 -5 -6 -3 -6 -1 -7 0 -8 -64 0 -3 -7 -1 -8 -64 0 -7 -7 -5 -7 -3 -8 -2 -9 0 -8 4 -7 6 -7 -64 -64 3710 27 -16 -9 12 -6 6 0 -6 -2 -8 0 -9 2 -8 0 -6 -64 0 0 -7 -1 -8 1 -8 0 -7 -64 -64 3711 33 -16 -9 12 -6 6 0 -12 0 -10 -2 -8 0 -6 1 -8 1 -10 0 -12 -2 -13 -64 0 0 -7 -1 -8 0 -9 0 -7 -64 -64 3712 49 -16 -9 12 -6 6 0 5 -2 3 0 2 2 3 0 5 -64 0 0 4 -1 3 1 3 0 4 -64 0 0 -6 -2 -8 0 -9 2 -8 0 -6 -64 0 0 -7 -1 -8 1 -8 0 -7 -64 -64 3713 55 -16 -9 12 -6 6 0 5 -2 3 0 2 2 3 0 5 -64 0 0 4 -1 3 1 3 0 4 -64 0 0 -12 0 -10 -2 -8 0 -6 1 -8 1 -10 0 -12 -2 -13 -64 0 0 -7 -1 -8 0 -9 0 -7 -64 -64 3714 65 -16 -9 12 -6 6 0 12 -1 11 -3 10 -1 9 0 -2 -64 0 0 9 1 10 0 11 -1 10 0 9 0 -2 -64 0 0 12 1 11 3 10 1 9 0 -2 -64 0 0 -6 -2 -8 0 -9 2 -8 0 -6 -64 0 0 -7 -1 -8 1 -8 0 -7 -64 -64 3715 107 -16 -9 12 -9 9 -6 8 -5 10 -4 11 -1 12 1 12 4 11 5 10 6 8 6 6 5 4 3 2 1 1 -64 0 -5 8 -4 10 -64 0 4 10 5 9 5 5 4 4 -64 0 -6 8 -4 7 -4 9 -3 11 -1 12 -64 0 1 12 3 11 4 9 4 5 3 3 1 1 -64 0 0 1 0 -2 1 1 -1 1 0 -2 -64 0 0 -6 -2 -8 0 -9 2 -8 0 -6 -64 0 0 -7 -1 -8 1 -8 0 -7 -64 -64 3716 33 -16 -9 12 -6 6 2 12 0 11 -1 9 -1 7 0 5 2 7 0 9 0 11 -64 0 0 8 0 6 1 7 0 8 -64 -64 3717 33 -16 -9 12 -6 6 0 6 0 8 -2 10 0 12 1 10 1 8 0 6 -2 5 -64 0 0 11 -1 10 0 9 0 11 -64 -64 3718 129 -16 -9 12 -13 13 7 4 8 3 9 3 10 4 -64 0 6 3 7 2 9 2 -64 0 6 2 7 1 8 1 9 2 10 4 -64 0 7 4 1 -2 -64 0 0 -3 -6 -9 -10 -4 -4 2 -64 0 -3 3 1 7 -3 12 -8 6 -2 0 2 -6 4 -8 6 -9 8 -9 9 -8 10 -6 -64 0 -6 -8 -9 -4 -64 0 0 7 -3 11 -64 0 -7 6 -2 1 2 -5 4 -7 6 -8 9 -8 -64 0 -5 -8 -9 -3 -64 0 0 6 -4 11 -64 0 -7 7 -1 1 3 -5 4 -6 6 -7 9 -7 10 -6 -64 -64 3719 125 -16 -9 12 -10 10 -2 16 -2 -13 -64 0 2 16 2 -13 -64 0 2 12 4 11 5 9 5 7 7 8 6 10 5 11 2 12 -2 12 -5 11 -7 9 -7 6 -6 4 -3 2 3 0 5 -1 6 -3 6 -6 5 -8 -64 0 6 8 5 10 -64 0 -6 6 -5 4 -3 3 3 1 5 0 6 -2 -64 0 -5 -7 -6 -5 -64 0 -5 11 -6 9 -6 7 -5 5 -3 4 3 2 6 0 7 -2 7 -5 6 -7 5 -8 2 -9 -2 -9 -5 -8 -6 -7 -7 -5 -5 -4 -5 -6 -4 -8 -2 -9 -64 -64 3720 21 -16 -9 12 -11 12 9 16 -9 -16 -8 -16 -64 0 9 16 10 16 -8 -16 -64 -64 3721 59 -16 -9 12 -7 7 3 16 1 14 -1 11 -3 7 -4 2 -4 -2 -3 -7 -1 -11 1 -14 3 -16 -64 0 -1 10 -2 7 -3 3 -3 -3 -2 -7 -1 -10 -64 0 1 14 0 12 -1 9 -2 3 -2 -3 -1 -9 0 -12 1 -14 -64 -64 3722 59 -16 -9 12 -7 7 -3 16 -1 14 1 11 3 7 4 2 4 -2 3 -7 1 -11 -1 -14 -3 -16 -64 0 1 10 2 7 3 3 3 -3 2 -7 1 -10 -64 0 -1 14 0 12 1 9 2 3 2 -3 1 -9 0 -12 -1 -14 -64 -64 3723 83 -16 -9 12 -8 8 0 12 -1 11 1 1 0 0 -64 0 0 12 0 0 -64 0 0 12 1 11 -1 1 0 0 -64 0 -5 9 -4 9 4 3 5 3 -64 0 -5 9 5 3 -64 0 -5 9 -5 8 5 4 5 3 -64 0 5 9 4 9 -4 3 -5 3 -64 0 5 9 -5 3 -64 0 5 9 5 8 -5 4 -5 3 -64 -64 3724 21 -16 -9 12 -12 13 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3725 37 -16 -9 12 -12 13 0 9 0 -8 1 -8 -64 0 0 9 1 9 1 -8 -64 0 -8 1 9 1 9 0 -64 0 -8 1 -8 0 9 0 -64 -64 3726 37 -16 -9 12 -12 13 -8 5 9 5 9 4 -64 0 -8 5 -8 4 9 4 -64 0 -8 -3 9 -3 9 -4 -64 0 -8 -3 -8 -4 9 -4 -64 -64 3727 27 -16 -9 12 -4 5 1 12 0 11 0 5 -64 0 1 11 0 5 -64 0 1 12 2 11 0 5 -64 -64 3728 49 -16 -9 12 -9 9 -4 12 -5 11 -5 5 -64 0 -4 11 -5 5 -64 0 -4 12 -3 11 -5 5 -64 0 5 12 4 11 4 5 -64 0 5 11 4 5 -64 0 5 12 6 11 4 5 -64 -64 3729 65 -16 -9 12 -7 7 -1 12 -3 11 -4 9 -4 7 -3 5 -1 4 1 4 3 5 4 7 4 9 3 11 1 12 -1 12 -64 0 -1 12 -4 9 -3 5 1 4 4 7 3 11 -1 12 -64 0 1 12 -3 11 -4 7 -1 4 3 5 4 9 1 12 -64 -64 3801 109 -16 -9 12 -13 13 -4 10 -6 9 -8 7 -9 5 -10 2 -10 -1 -9 -3 -7 -4 -64 0 -8 6 -9 3 -9 -1 -8 -3 -64 0 -4 10 -6 8 -7 6 -8 3 -8 0 -7 -4 -7 -6 -8 -8 -10 -9 -64 0 4 10 6 10 6 -7 4 -7 -64 0 7 10 7 -7 -64 0 8 11 8 -8 -64 0 -10 12 -7 11 -1 10 4 10 8 11 10 12 -64 0 -8 2 6 2 -64 0 -10 -9 -7 -8 -1 -7 4 -7 8 -8 10 -9 -64 -64 3802 135 -16 -9 12 -13 13 -6 11 -6 -8 -64 0 -5 11 -5 -8 -64 0 -2 12 -4 11 -4 -8 -2 -9 -64 0 -10 8 -8 10 -6 11 -2 12 3 12 6 11 8 9 8 7 7 5 -64 0 6 10 7 9 7 7 6 5 -64 0 3 12 5 11 6 9 6 7 5 6 -64 0 -1 -3 -3 -2 -4 0 -4 2 -3 4 -2 5 1 6 4 6 7 5 9 3 10 1 10 -2 9 -5 7 -7 5 -8 2 -9 -2 -9 -6 -8 -8 -7 -10 -5 -64 0 8 3 9 1 9 -3 8 -5 -64 0 4 6 7 4 8 1 8 -3 7 -6 5 -8 -64 -64 3803 125 -16 -9 12 -13 13 10 12 9 10 8 8 6 10 4 11 1 12 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -7 10 -9 -64 0 9 10 8 5 8 -2 9 -7 -64 0 8 7 7 8 -64 0 8 4 7 7 6 9 4 11 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 7 -5 8 -4 -64 0 4 -8 6 -6 7 -4 8 -1 -64 -64 3804 97 -16 -9 12 -13 13 -7 11 -7 -8 -64 0 -6 11 -6 -8 -64 0 -4 12 -5 11 -5 -8 -4 -9 -64 0 -10 7 -9 9 -7 11 -4 12 1 12 4 11 6 10 8 8 9 6 10 3 10 0 9 -3 8 -5 6 -7 4 -8 1 -9 -4 -9 -7 -8 -9 -6 -10 -4 -64 0 8 7 9 4 9 -1 8 -4 -64 0 4 11 6 9 7 7 8 4 8 -1 7 -4 6 -6 4 -8 -64 -64 3805 177 -16 -9 12 -13 13 10 12 9 10 8 8 6 10 4 11 1 12 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -7 10 -9 -64 0 9 10 8 5 8 -2 9 -7 -64 0 8 7 7 8 -64 0 8 5 6 9 4 11 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 7 -5 8 -4 -64 0 4 -8 6 -6 7 -4 8 -1 -64 0 -8 2 -7 3 -4 3 3 1 6 1 8 2 -64 0 -2 2 0 1 3 0 5 0 7 1 -64 0 -5 3 0 0 3 -1 5 -1 7 0 8 2 -64 0 8 5 7 6 6 6 5 5 6 4 7 5 -64 -64 3806 143 -16 -9 12 -13 13 -8 10 -8 -8 -64 0 -5 11 -7 10 -7 -7 -64 0 -3 12 -5 11 -6 9 -6 -7 -4 -7 -64 0 -10 8 -8 10 -6 11 -3 12 1 12 4 11 6 10 7 9 10 12 -64 0 10 12 9 10 8 6 8 3 9 -1 10 -3 -64 0 8 9 7 7 -64 0 4 11 6 9 7 6 8 3 -64 0 -6 2 -5 3 -3 3 2 2 5 2 7 3 -64 0 -1 2 2 1 4 1 6 2 -64 0 -4 3 2 0 4 0 6 1 7 3 7 6 6 7 5 7 4 6 5 5 6 6 -64 0 -10 -9 -8 -8 -4 -7 1 -7 7 -8 10 -9 -64 -64 3807 185 -16 -9 12 -13 13 10 12 9 10 8 8 6 10 4 11 1 12 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 2 -9 4 -8 6 -7 7 -6 8 -4 9 -7 10 -9 -64 0 9 10 8 5 8 -2 9 -7 -64 0 8 7 7 8 -64 0 8 4 7 7 6 9 4 11 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 6 -6 7 -4 7 0 -64 0 4 -8 5 -7 6 -4 6 1 -64 0 -7 -1 -6 0 -5 -1 -6 -2 -7 -2 -8 -1 -64 0 -8 2 -7 4 -5 5 -3 5 0 4 3 2 5 1 -64 0 -7 3 -5 4 -3 4 0 3 2 2 -64 0 -8 2 -6 3 -3 3 3 1 7 1 8 2 -64 -64 3808 105 -16 -9 12 -13 13 -8 11 -8 -8 -10 -9 -64 0 -7 10 -7 -8 -64 0 -4 10 -6 10 -6 -8 -64 0 -10 12 -8 11 -4 10 1 10 7 11 10 12 -64 0 -6 2 -5 4 -3 6 0 7 4 7 7 6 9 4 10 1 10 -2 9 -3 7 -4 -64 0 8 4 9 2 9 -1 8 -3 -64 0 4 7 6 6 7 5 8 3 8 -1 7 -4 7 -6 8 -8 10 -9 -64 0 -10 -9 -6 -8 -2 -8 3 -9 -64 -64 3809 51 -16 -9 12 -13 13 -1 9 -1 -7 -64 0 0 8 0 -6 -64 0 1 9 1 -7 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 0 -10 -9 -7 -8 -3 -7 3 -7 7 -8 10 -9 -64 -64 3810 89 -16 -9 12 -13 13 2 9 4 9 4 -6 3 -8 1 -9 -64 0 5 9 5 -6 4 -7 -64 0 6 10 6 -7 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 0 -9 3 -10 1 -10 -3 -9 -6 -7 -8 -4 -9 1 -9 4 -8 6 -7 8 -5 10 -2 -64 0 -9 -3 -8 -6 -7 -7 -64 0 -10 -1 -8 -3 -7 -6 -6 -8 -4 -9 -64 -64 3811 145 -16 -9 12 -13 13 -8 11 -8 -8 -10 -9 -64 0 -7 10 -7 -8 -64 0 -4 10 -6 10 -6 -8 -64 0 -10 12 -8 11 -4 10 1 10 7 11 10 12 -64 0 -6 2 -5 4 -3 6 0 7 3 7 6 6 7 5 7 3 6 2 1 0 -1 -1 -2 -2 -2 -3 -1 -4 0 -3 -1 -2 -64 0 5 6 6 5 6 3 5 2 -64 0 3 7 5 5 5 3 4 2 1 0 -64 0 1 0 4 0 7 -1 8 -3 8 -5 7 -6 -64 0 5 -1 7 -3 7 -5 -64 0 1 0 4 -1 6 -3 7 -6 8 -8 9 -9 10 -9 -64 0 -10 -9 -6 -8 -2 -8 3 -9 -64 -64 3812 95 -16 -9 12 -13 13 -8 11 -8 -8 -64 0 -7 10 -7 -7 -64 0 -4 10 -6 10 -6 -7 -4 -7 -64 0 10 7 8 4 7 2 6 -1 6 -3 7 -5 9 -6 -64 0 8 3 7 0 7 -3 8 -5 -64 0 10 7 9 5 8 1 8 -2 9 -6 10 -9 -64 0 -10 12 -8 11 -4 10 1 10 7 11 10 12 -64 0 -10 -9 -8 -8 -4 -7 1 -7 7 -8 10 -9 -64 -64 3813 141 -16 -9 12 -13 13 -1 9 -1 -7 -64 0 0 8 0 -6 -64 0 1 9 1 -7 -64 0 -4 -7 -6 -5 -8 -4 -9 -3 -10 0 -10 5 -9 8 -7 10 -5 11 -2 12 2 12 5 11 7 10 9 8 10 5 10 0 9 -3 8 -4 6 -5 4 -7 -64 0 -8 -3 -9 0 -9 5 -8 8 -64 0 -6 -5 -7 -3 -8 0 -8 6 -7 9 -5 11 -64 0 8 8 9 5 9 0 8 -3 -64 0 5 11 7 9 8 6 8 0 7 -3 6 -5 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 0 -10 -9 -7 -8 -3 -7 3 -7 7 -8 10 -9 -64 -64 3814 101 -16 -9 12 -13 13 -8 10 -8 -8 -10 -9 -64 0 -6 10 -7 9 -7 -8 -64 0 -3 12 -5 11 -6 9 -6 -8 -64 0 -10 8 -8 10 -6 11 -3 12 1 12 4 11 6 10 8 8 9 6 10 3 10 -1 9 -3 7 -4 -64 0 8 7 9 4 9 0 8 -3 -64 0 4 11 6 9 7 7 8 4 8 0 7 -4 7 -6 8 -8 9 -9 10 -9 -64 0 -10 -9 -6 -8 -2 -8 3 -9 -64 -64 3815 113 -16 -9 12 -13 13 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 3 9 6 8 8 6 10 4 11 1 12 -1 12 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 8 -4 9 -1 9 4 8 7 -64 0 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 -64 -64 3816 107 -16 -9 12 -13 13 -8 9 -8 -8 -64 0 -5 10 -7 8 -7 -7 -64 0 -1 12 -3 11 -5 9 -6 7 -6 -7 -4 -7 -64 0 -10 7 -8 9 -4 11 -1 12 2 12 5 11 7 10 9 8 10 5 10 3 9 0 7 -2 4 -3 0 -3 -3 -2 -5 0 -6 3 -64 0 8 8 9 6 9 2 8 0 -64 0 5 11 7 9 8 6 8 2 7 -1 4 -3 -64 0 -10 -9 -8 -8 -4 -7 1 -7 7 -8 10 -9 -64 -64 3817 153 -16 -9 12 -13 13 -1 12 -4 11 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 3 9 6 8 8 6 10 4 11 1 12 -1 12 -64 0 -8 7 -9 4 -9 -1 -8 -4 -64 0 -4 11 -6 9 -7 7 -8 4 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 8 -4 9 -1 9 4 8 7 -64 0 4 -8 6 -6 7 -4 8 -1 8 4 7 7 6 9 4 11 -64 0 -8 -1 -7 -3 -4 -4 2 -5 9 -5 10 -6 10 -8 9 -9 9 -8 10 -7 -64 0 -2 -5 0 -5 -64 0 -7 -3 -4 -5 -1 -6 1 -6 2 -5 -64 -64 3818 143 -16 -9 12 -13 13 -8 9 -8 -8 -10 -9 -64 0 -7 9 -7 -8 -64 0 -6 10 -6 -8 -64 0 -10 7 -8 9 -6 10 -4 11 -1 12 3 12 7 11 9 9 10 7 10 4 9 2 8 1 -64 0 7 10 8 9 9 7 9 4 8 2 -64 0 3 12 5 11 7 9 8 7 8 3 7 1 -64 0 6 0 3 -1 0 -1 -2 0 -2 2 0 3 3 3 6 2 8 0 10 -3 10 -5 9 -6 8 -6 -64 0 6 1 7 0 9 -4 9 -5 8 -2 -64 0 2 3 4 2 6 0 7 -2 8 -6 9 -8 10 -9 -64 0 -10 -9 -6 -8 -2 -8 3 -9 -64 -64 3819 193 -16 -9 12 -13 13 2 12 8 11 10 12 9 10 9 8 7 10 5 11 2 12 -2 12 -5 11 -8 8 -9 5 -9 3 -8 0 -6 -2 -3 -3 0 -3 2 -2 3 -1 4 1 4 2 -64 0 9 11 8 10 9 8 -64 0 -8 2 -7 0 -6 -1 -3 -2 0 -2 2 -1 -64 0 -7 9 -8 7 -8 4 -7 2 -5 0 -2 -1 0 -1 2 0 4 2 5 3 6 3 -64 0 -6 1 -5 1 -4 2 -2 4 0 5 3 5 5 4 7 2 8 0 8 -3 7 -6 5 -8 -64 0 -2 5 0 6 3 6 6 5 8 3 9 0 9 -3 8 -5 -64 0 -9 -5 -8 -7 -9 -8 -64 0 -4 2 -4 3 -3 5 -2 6 0 7 3 7 6 6 9 3 10 0 10 -2 9 -5 7 -7 5 -8 2 -9 -2 -9 -5 -8 -7 -7 -9 -5 -9 -7 -10 -9 -8 -8 -2 -9 -64 -64 3820 137 -16 -9 12 -13 13 -1 10 -5 10 -7 9 -8 8 -9 6 -10 3 -10 -1 -9 -4 -8 -6 -7 -7 -5 -8 -2 -9 1 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 4 9 7 7 9 5 10 -64 0 3 10 2 9 2 7 3 6 4 7 3 8 -64 0 -9 -1 -8 -4 -6 -6 -4 -7 -1 -8 2 -8 5 -7 -64 0 -8 8 -9 4 -9 1 -8 -2 -6 -5 -4 -6 -1 -7 2 -7 5 -6 7 -5 9 -2 10 0 -64 0 -10 12 -7 9 -64 0 -7 10 -6 11 -64 0 -9 11 -8 11 -7 12 -5 11 -1 10 5 10 8 11 10 12 -64 -64 3821 107 -16 -9 12 -13 13 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 3 -9 6 -8 8 -7 -64 0 -7 8 -8 6 -9 3 -9 -1 -8 -4 -64 0 -7 9 -6 8 -6 7 -7 5 -8 2 -8 -1 -7 -4 -6 -6 -4 -8 -64 0 4 10 6 10 6 -6 5 -8 3 -9 -64 0 7 10 7 -6 6 -7 -64 0 8 11 8 -7 10 -9 -64 0 -10 12 -7 11 -1 10 4 10 8 11 10 12 -64 -64 3822 67 -16 -9 12 -13 13 -10 12 0 -9 -64 0 -9 11 -8 10 -1 -5 0 -7 -64 0 -8 11 -7 10 0 -5 1 -6 -64 0 10 12 0 -9 -64 0 5 4 3 -1 -64 0 7 6 3 1 2 -2 2 -4 -64 0 -10 12 -8 11 -3 10 3 10 8 11 10 12 -64 -64 3823 139 -16 -9 12 -13 13 -6 10 -8 8 -9 6 -10 3 -10 0 -9 -3 -8 -5 -6 -7 -4 -8 -1 -9 1 -9 4 -8 6 -7 8 -5 9 -3 10 0 10 3 9 6 8 8 6 10 -64 0 -8 6 -9 3 -9 0 -8 -3 -7 -5 -64 0 -8 8 -7 7 -7 6 -8 3 -8 0 -7 -4 -6 -6 -4 -8 -64 0 7 -5 8 -3 9 0 9 3 8 6 -64 0 4 -8 6 -6 7 -4 8 0 8 3 7 6 7 7 8 8 -64 0 -1 9 -1 -9 -64 0 0 8 0 -8 -64 0 1 9 1 -9 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 -64 3824 87 -16 -9 12 -13 13 -10 12 6 -7 7 -8 -64 0 -9 11 -7 10 8 -8 -64 0 -6 10 10 -9 -64 0 10 12 1 2 -64 0 -1 0 -8 -8 -64 0 -2 -1 -5 -3 -6 -5 -64 0 -1 0 -5 -2 -6 -3 -7 -5 -7 -7 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 0 -10 -9 -8 -8 -4 -7 1 -7 7 -8 10 -9 -64 -64 3825 99 -16 -9 12 -13 13 6 10 6 -8 -64 0 7 10 7 -7 -64 0 8 11 8 -7 -64 0 -7 10 -9 8 -10 5 -10 2 -9 -1 -7 -3 -5 -4 -2 -5 1 -5 4 -4 6 -3 -64 0 -6 -3 -3 -4 3 -4 -64 0 -10 2 -9 0 -7 -2 -4 -3 2 -3 4 -4 -64 0 -10 12 -6 10 -2 9 2 9 6 10 10 12 -64 0 -10 -5 -8 -7 -6 -8 -2 -9 2 -9 6 -8 10 -6 -64 -64 3826 151 -16 -9 12 -13 13 -10 12 -9 11 -7 10 -4 10 1 12 4 12 7 11 8 9 8 7 7 5 -64 0 6 11 7 9 7 7 6 5 -64 0 4 12 5 11 6 9 6 6 -64 0 6 4 2 3 0 3 -2 4 -2 6 0 7 2 7 6 6 -64 0 2 7 4 6 5 5 4 4 2 3 -64 0 7 5 9 3 10 0 10 -2 9 -5 7 -7 5 -8 2 -9 -2 -9 -5 -8 -7 -7 -9 -5 -10 -2 -10 0 -9 3 -8 4 -6 5 -4 5 -2 4 -2 2 -3 1 -4 2 -3 3 -64 0 6 5 8 3 9 1 9 -3 8 -5 -64 0 6 4 7 3 8 1 8 -3 7 -6 5 -8 -64 -64 3901 89 -16 -9 12 -8 9 -2 1 -5 -2 -5 -6 -2 -9 2 -7 -64 0 -4 -2 -4 -6 -2 -8 -64 0 -3 0 -3 -5 0 -8 -64 0 0 -1 -5 4 -4 5 -3 4 -4 3 -64 0 -3 4 1 4 3 5 5 3 5 -6 6 -7 -64 0 3 4 4 3 4 -6 3 -7 4 -8 5 -7 4 -6 -64 0 1 4 3 2 3 -6 2 -7 4 -9 6 -7 -64 -64 3902 67 -16 -9 12 -9 8 -4 10 -6 12 -5 8 -5 -6 -2 -9 3 -7 5 -6 -64 0 -4 10 -4 -6 -2 -8 -64 0 -4 10 -2 12 -3 8 -3 -5 0 -8 -64 0 -3 3 2 5 5 2 5 -6 -64 0 2 4 4 2 4 -6 -64 0 0 4 3 1 3 -7 -64 -64 3903 51 -16 -9 12 -7 5 -4 2 -4 -7 -2 -9 0 -7 -64 0 -3 2 -3 -7 -2 -8 -64 0 -2 3 -2 -6 -1 -7 0 -7 -64 0 -4 2 2 5 4 3 2 2 0 4 -64 0 1 4 3 3 -64 -64 3904 69 -16 -9 12 -8 8 0 5 -5 2 -5 -6 -2 -9 0 -8 3 -7 5 -7 -64 0 -4 2 -4 -6 -2 -8 -64 0 -3 3 -3 -5 0 -8 -64 0 -2 9 -2 12 -1 9 5 2 5 -7 -64 0 -2 9 4 2 4 -6 -64 0 -2 9 -5 9 -2 8 3 2 3 -7 -64 -64 3905 55 -16 -9 12 -7 6 -4 2 -4 -7 -2 -9 0 -7 -64 0 -3 2 -3 -7 -2 -8 -64 0 -2 3 -2 -6 -1 -7 0 -7 -64 0 -4 2 2 5 5 1 -2 -3 -64 0 1 4 4 1 -64 0 0 4 3 0 -64 -64 3906 69 -16 -9 12 -7 5 -3 9 -3 -6 -4 -7 -2 -9 -64 0 -2 9 -2 -6 -3 -7 -2 -8 -1 -7 -2 -6 -64 0 -1 10 -1 -6 0 -7 -2 -9 -64 0 -3 9 3 12 5 10 3 9 1 11 -64 0 2 11 4 10 -64 0 -6 5 -3 5 -64 0 -1 5 3 5 -64 -64 3907 87 -16 -9 12 -8 9 -5 2 -5 -6 -2 -9 3 -7 -64 0 -4 2 -4 -6 -2 -8 -64 0 -3 3 -3 -5 0 -8 -64 0 -5 2 -3 3 2 5 5 2 5 -11 4 -13 3 -14 1 -15 -1 -15 -3 -14 -5 -15 -3 -16 -1 -15 -64 0 2 4 4 2 4 -11 3 -13 -64 0 -2 -15 -4 -15 -64 0 0 4 3 1 3 -12 2 -14 1 -15 -64 -64 3908 89 -16 -9 12 -9 9 -4 10 -6 12 -5 8 -5 -6 -6 -7 -4 -9 -64 0 -4 10 -4 -6 -5 -7 -4 -8 -3 -7 -4 -6 -64 0 -4 10 -2 12 -3 8 -3 -6 -2 -7 -4 -9 -64 0 -3 3 0 4 2 5 5 2 5 -7 2 -11 2 -14 3 -16 4 -16 2 -14 -64 0 2 4 4 2 4 -7 3 -9 -64 0 0 4 3 1 3 -8 2 -11 -64 -64 3909 79 -16 -9 12 -5 5 0 12 -2 10 0 8 2 10 0 12 -64 0 0 11 -1 10 0 9 1 10 0 11 -64 0 0 5 -2 3 -1 2 -1 -6 -2 -7 0 -9 -64 0 0 2 1 3 0 4 -1 3 0 2 0 -6 -1 -7 0 -8 1 -7 0 -6 -64 0 0 5 2 3 1 2 1 -6 2 -7 0 -9 -64 -64 3910 79 -16 -9 12 -5 5 0 12 -2 10 0 8 2 10 0 12 -64 0 0 11 -1 10 0 9 1 10 0 11 -64 0 0 5 -2 3 -1 2 -1 -7 2 -11 -64 0 0 2 1 3 0 4 -1 3 0 2 0 -7 1 -9 -64 0 0 5 2 3 1 2 1 -8 2 -11 2 -14 0 -16 -2 -15 -2 -16 0 -16 -64 -64 3911 107 -16 -9 12 -9 8 -4 10 -6 12 -5 8 -5 -6 -6 -7 -4 -9 -64 0 -4 10 -4 -6 -5 -7 -4 -8 -3 -7 -4 -6 -64 0 -4 10 -2 12 -3 8 -3 -6 -2 -7 -4 -9 -64 0 -3 2 0 4 2 5 4 2 1 0 -3 -3 -64 0 1 4 3 2 -64 0 0 4 2 1 -64 0 0 -1 1 -2 2 -7 4 -9 6 -7 -64 0 1 -1 2 -3 3 -7 4 -8 -64 0 1 0 2 -1 4 -6 5 -7 6 -7 -64 -64 3912 47 -16 -9 12 -5 5 0 10 -2 12 -1 8 -1 -6 -2 -7 0 -9 -64 0 0 10 0 -6 -1 -7 0 -8 1 -7 0 -6 -64 0 0 10 2 12 1 8 1 -6 2 -7 0 -9 -64 -64 3913 137 -16 -9 12 -13 13 -11 3 -10 3 -9 2 -9 -6 -10 -7 -8 -9 -64 0 -9 4 -8 3 -8 -6 -9 -7 -8 -8 -7 -7 -8 -6 -64 0 -11 3 -9 5 -7 3 -7 -6 -6 -7 -8 -9 -64 0 -7 3 -4 4 -2 5 1 3 1 -6 2 -7 0 -9 -64 0 -2 4 0 3 0 -6 -1 -7 0 -8 1 -7 0 -6 -64 0 -4 4 -1 2 -1 -6 -2 -7 0 -9 -64 0 1 3 4 4 6 5 9 3 9 -6 10 -7 8 -9 -64 0 6 4 8 3 8 -6 7 -7 8 -8 9 -7 8 -6 -64 0 4 4 7 2 7 -6 6 -7 8 -9 -64 -64 3914 93 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -6 -6 -7 -4 -9 -64 0 -5 4 -4 3 -4 -6 -5 -7 -4 -8 -3 -7 -4 -6 -64 0 -7 3 -5 5 -3 3 -3 -6 -2 -7 -4 -9 -64 0 -3 3 0 4 2 5 5 3 5 -6 6 -7 4 -9 -64 0 2 4 4 3 4 -6 3 -7 4 -8 5 -7 4 -6 -64 0 0 4 3 2 3 -6 2 -7 4 -9 -64 -64 3915 61 -16 -9 12 -8 8 -5 2 -5 -6 -2 -9 3 -7 5 -6 -64 0 -4 2 -4 -6 -2 -8 -64 0 -3 3 -3 -5 0 -8 -64 0 -5 2 -3 3 2 5 5 2 5 -6 -64 0 2 4 4 2 4 -6 -64 0 0 4 3 1 3 -7 -64 -64 3916 99 -16 -9 12 -9 8 -6 5 -5 3 -5 -6 -7 -7 -5 -7 -5 -13 -6 -16 -4 -14 -64 0 -4 3 -4 -14 -64 0 -6 5 -4 4 -3 3 -3 -6 -1 -7 0 -8 -64 0 -4 -7 -3 -7 -1 -8 -64 0 -3 -8 -2 -9 3 -7 5 -6 -64 0 -3 -8 -3 -13 -2 -16 -4 -14 -64 0 -3 3 0 4 2 5 5 2 5 -6 -64 0 2 4 4 2 4 -6 -64 0 0 4 3 1 3 -7 -64 -64 3917 67 -16 -9 12 -8 9 -5 2 -5 -6 -2 -9 3 -7 -64 0 -4 2 -4 -6 -2 -8 -64 0 -3 3 -3 -5 0 -8 -64 0 -5 2 -3 3 2 5 5 2 5 -13 6 -16 4 -14 -64 0 2 4 4 2 4 -14 -64 0 0 4 3 1 3 -13 2 -16 4 -14 -64 -64 3918 67 -16 -9 12 -7 6 -5 3 -4 3 -3 2 -3 -6 -4 -7 -2 -9 -64 0 -3 4 -2 3 -2 -6 -3 -7 -2 -8 -1 -7 -2 -6 -64 0 -5 3 -3 5 -1 3 -1 -6 0 -7 -2 -9 -64 0 -1 3 3 5 5 3 3 2 1 4 -64 0 2 4 4 3 -64 -64 3919 87 -16 -9 12 -8 8 -5 2 -5 -1 -3 -3 3 0 5 -2 5 -6 -64 0 -4 2 -4 -1 -3 -2 -64 0 -3 3 -3 -1 -2 -2 -64 0 3 -1 4 -2 4 -6 -64 0 2 -1 3 -2 3 -7 -64 0 -5 2 1 5 4 4 2 3 -1 4 -64 0 0 4 3 4 -64 0 5 -6 -1 -9 -5 -7 -3 -6 1 -8 -64 0 -3 -7 -1 -8 -64 -64 3920 59 -16 -9 12 -5 5 0 10 -2 12 -1 8 -1 -6 -2 -7 0 -9 -64 0 0 10 0 -6 -1 -7 0 -8 1 -7 0 -6 -64 0 0 10 2 12 1 8 1 -6 2 -7 0 -9 -64 0 -4 5 -1 5 -64 0 1 5 4 5 -64 -64 3921 85 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -7 -2 -9 3 -7 -64 0 -5 4 -4 3 -4 -7 -2 -8 -64 0 -7 3 -5 5 -3 3 -3 -6 0 -8 -64 0 4 5 6 3 5 2 5 -6 6 -7 7 -7 -64 0 4 2 5 3 4 4 3 3 4 2 4 -7 5 -8 -64 0 4 5 2 3 3 2 3 -7 5 -9 7 -7 -64 -64 3922 77 -16 -9 12 -9 9 -6 5 -5 3 -5 -6 -1 -9 1 -7 5 -5 -64 0 -5 4 -4 3 -4 -6 -1 -8 -64 0 -6 5 -4 4 -3 3 -3 -5 0 -7 1 -7 -64 0 4 5 6 3 5 2 5 -5 -64 0 4 2 5 3 4 4 3 3 4 2 4 -5 -64 0 4 5 2 3 3 2 3 -6 -64 -64 3923 123 -16 -9 12 -13 13 -10 5 -9 3 -9 -6 -5 -9 -3 -7 -1 -6 -64 0 -9 4 -8 3 -8 -6 -5 -8 -64 0 -10 5 -8 4 -7 3 -7 -5 -4 -7 -3 -7 -64 0 0 5 -2 3 -1 2 -1 -6 3 -9 5 -7 9 -5 -64 0 0 2 1 3 0 4 -1 3 0 2 0 -6 3 -8 -64 0 0 5 2 3 1 2 1 -5 4 -7 5 -7 -64 0 8 5 10 3 9 2 9 -5 -64 0 8 2 9 3 8 4 7 3 8 2 8 -5 -64 0 8 5 6 3 7 2 7 -6 -64 -64 3924 83 -16 -9 12 -9 9 -6 3 -4 2 3 -8 4 -9 6 -7 -64 0 -5 4 -3 3 3 -7 5 -8 -64 0 -6 3 -4 5 -3 4 4 -6 6 -7 -64 0 6 5 4 5 4 3 6 3 6 5 4 3 1 -1 -64 0 -1 -3 -4 -7 -6 -9 -4 -9 -4 -7 -6 -7 -6 -9 -64 0 -4 -2 -1 -2 -64 0 1 -2 4 -2 -64 -64 3925 103 -16 -9 12 -9 9 -7 3 -6 3 -5 2 -5 -7 -2 -9 3 -7 -64 0 -5 4 -4 3 -4 -7 -2 -8 -64 0 -7 3 -5 5 -3 3 -3 -6 0 -8 -64 0 4 5 6 3 5 2 5 -11 4 -13 3 -14 1 -15 -1 -15 -3 -14 -5 -15 -3 -16 -1 -15 -64 0 4 2 5 3 4 4 3 3 4 2 4 -12 3 -13 -64 0 -2 -15 -4 -15 -64 0 4 5 2 3 3 2 3 -12 2 -14 1 -15 -64 -64 3926 91 -16 -9 12 -6 9 0 4 -3 2 -3 3 0 4 2 5 5 3 5 -1 0 -3 -64 0 2 4 4 3 4 -1 -64 0 0 4 3 2 3 -1 2 -2 -64 0 0 -3 5 -5 5 -11 4 -13 3 -14 1 -15 -1 -15 -3 -14 -5 -15 -3 -16 -1 -15 -64 0 4 -5 4 -12 3 -13 -64 0 -2 -15 -4 -15 -64 0 2 -4 3 -5 3 -12 2 -14 1 -15 -64 -64 4000 81 -16 -9 12 -9 9 -5 -8 -4 -7 -5 -6 -6 -7 -6 -8 -5 -10 -4 -11 -2 -12 1 -12 4 -11 5 -10 6 -8 6 -6 5 -4 4 -3 0 -1 0 2 -64 0 1 -12 3 -11 4 -10 5 -8 5 -6 4 -4 2 -2 -64 0 0 7 -1 8 0 9 1 8 0 7 -64 0 9 -16 9 12 -9 12 -9 -16 9 -16 -64 -64 -3 3 -3 -5 0 -8 -64 0 -2 9 -2 12 -1 9 5 2 5 -7 -64 0 -2 9 4 2 4 -6 -pgplot/fonts/aaaread.me010064400040640000322000000077040571102474100155750ustar00tjpcitmbr00000400000017This directory contains three programs for manipulating the Hershey character set used by PGPLOT. Note: only pgpack is required to install PGPLOT. The other two programs, pgunpack and pgdchar, are not supported and may not work on all systems. pgunpack.f: convert the binary file grfont.dat into an editable text file grfont.txt pgpack.f: perform the reverse operation. (pgpack.ngh is a variant version of this program for the Oasys Green Hill Fortran compiler on NeXT systems) pgdchar.f: display the construction of selected characters on any PGPLOT device. ------------------------------------------------------------------------ WARNING ------------------------------------------------------------------------ Do not change the index numbers assigned to the Hershey symbols: they are used throughout PGPLOT. Do not delete existing Hershey symbols. Do not modify existing Hershey symbols. If you add new symbols, note that the internal buffers used by PGPLOT have a finite capacity. If you exceed this capacity, you will have to increase the buffer size, and will thereby generate a version of PGPLOT which is incompatible with all other versions. ------------------------------------------------------------------------ The ASCII font file (GRFONT.TXT) contains the character digitizations in record groups, as follows: first: NC,LENGTH,(XYGRID(I),I=1,5) remaining: (XYGRID(I),I=6,LENGTH) The Fortran format for each record is (7(2X,2I4)). NC is the Hershey character number, which is an integer in the range 1-4000. Not all numbers have corresponding characters (only about 1600 characters are defined). The character number is used to identify the character. LENGTH is the number of entries in the XYGRID array for this character. It is always at least 5; it is equal to 5 for non-printing characters (spaces of various widths). The first five entries in XYGRID(*) are the character extents: XYGRID(1) = minimum y value. XYGRID(2) = baseline y value. XYGRID(3) = maximum y value. XYGRID(4) = minimum x value. XYGRID(5) = maximum x value. The minimum and maximum values do not necessarily correspond to the actual (x,y) coordinates in the remainder of xygrid(*), but specify a `bounding box' for the character. The center of each character grid is at (0,0), and actual coordinates lie in the range (-49..+49). A coordinate pair (-64,0) is a request to raise the pen before moving to the next point, and a pair (-64,-64) signals end-of-data for the current character. For normal roman characters, the baseline is the line on which the base of the character is placed, the minimum y-value is reached by lower-case descenders, and the maximum y-value is the level of the top of upper-case letters. For standard-size letters, the `height' (maximum y minus baseline) is 21 units, and the `depth' (baseline minus minimum y) is 7 units. Thus in continuous text, successive baselines must be separated by at least 28 units. The character `width' (maximum x minus minimum x) is different for different characters. The bounding box includes intercharacter spacing, so the left edge of the bounding box of one character should normally abut the right edge of the preceding character. The font file contains no `kerning' information for fine adjustment of character spacing for special pairs like 'AV'. Some characters (e.g., lower case italic `f') extend outside the bouding box, but the bounding boxes should still abut for correct character placement. For the internal binary representation of the character digitization it is necessary to choose a coding that is efficient in both space and cpu time. The coordinates are all in the range (-64,49) and could be represented in an 8-bit signed integer, such as the VAX BYTE data type. PGPLOT actually follows Nelson Beebe's PLOT79 package, however: it adds 64 to each coordinate and then packs two coordinates in an INTEGER*2 word. This implementation should be portable to any system in which the INTEGER data type is 16 or more bits. pgplot/fonts/pgpack.f010064400040640000322000000062730503521504700153100ustar00tjpcitmbr00000400000017 PROGRAM PACK C----------------------------------------------------------------------- C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000) C INTEGER INDEX(MAXCHR) INTEGER*2 BUFFER(MAXBUF) INTEGER I, LENGTH, LOC, NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open stdin. C C Read input file. C 10 CONTINUE C -- read next character READ (*,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (*,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC BUFFER(LOC) = XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE C C Write output file. C OPEN (UNIT=2, STATUS='NEW', FORM='UNFORMATTED', FILE='grfont.dat') NC1 = 1 NC2 = 3000 WRITE (2) NC1,NC2,LOC,INDEX,BUFFER CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/examples/aaaread.me010064400040640000322000000041660634703765000162720ustar00tjpcitmbr00000400000017This directory contains test/demonstration programs for PGPLOT. Fortran programs: pgdemo*.f The following table (generated with procedure 'check' in this directory) indicates which routines are exercised by each demo program. pgarro : 1 3 13 pgask : 4 13 17 pgaxis : pgaxlg : pgband : 6 14 pgbbuf : 1 2 3 7 8 11 13 14 15 16 17 pgbeg : 3 5 6 7 8 9 10 11 13 15 pgbin : pgbox : 1 2 3 4 5 6 9 10 11 13 16 pgbox1 : pgcirc : 1 2 13 15 pgcl : pgclos : 1 2 12 14 16 17 pgcn01 : pgcnsc : pgconb : 3 15 pgconf : 3 pgconl : 3 pgcons : 3 pgcont : 3 4 9 15 pgconx : 3 pgcp : pgctab : 4 pgcurs : 4 13 14 pgdraw : 1 2 3 7 13 14 pgebuf : 1 2 3 7 8 11 13 14 15 16 17 pgend : 3 4 5 6 7 8 9 10 11 13 15 pgenv : 1 2 3 7 10 11 12 13 15 17 pgeras : 2 8 10 11 13 14 17 pgerrb : pgerrx : pgerry : 1 13 pgetxt : pgfunt : 1 13 pgfunx : 1 13 pgfuny : pggray : pghi2d : pghis1 : pghist : 1 13 pghtch : pgiden : 15 pgimag : 4 pginit : pglab : 1 2 3 10 12 13 15 16 pglcur : 5 pgldev : pglen : pgline : 1 2 3 4 8 10 11 13 17 pgmove : 1 2 3 7 13 14 pgmtxt : 1 2 3 4 9 11 13 16 pgncur : pgnoto : 16 pgnpl : pgnumb : pgolin : 5 pgopen : 1 2 4 12 13 14 15 16 17 pgpage : 1 2 3 4 5 6 8 9 10 11 12 13 14 16 pgpanl : pgpap : 12 13 14 pgpixl : 9 pgpnts : pgpoly : 1 2 5 13 pgpt : 1 10 13 17 pgpt1 : 1 2 3 6 13 pgptxt : 1 2 13 14 pgqah : pgqcf : pgqch : pgqci : 14 16 pgqcir : 4 pgqclp : pgqcol : 8 9 pgqcr : pgqcs : pgqdt : pgqfs : pgqhs : pgqid : pgqinf : 1 2 4 11 pgqitf : pgqls : pgqlw : pgqndt : pgqpos : 3 pgqtbg : pgqtxt : 14 pgqvp : 2 4 pgqvsz : 1 pgqwin : 4 pgrect : 1 2 10 13 14 16 pgrnd : pgrnge : 16 pgsah : 1 13 15 pgsave : 1 2 13 14 16 pgscf : 10 pgsch : 1 2 3 4 10 13 14 15 pgsci : 1 2 3 4 5 8 9 10 11 13 14 15 16 17 pgscir : pgsclp : pgscr : 1 2 3 8 9 10 13 14 pgscrl : pgscrn : 10 pgsfs : 1 2 3 13 14 15 16 pgshls : pgshs : 2 pgsitf : pgslct : 13 pgsls : 1 2 3 4 8 13 16 pgslw : 1 2 3 4 10 13 14 16 17 pgstbg : 1 13 pgsubp : 1 13 16 pgsvp : 1 2 3 4 5 6 9 13 14 pgswin : 1 2 3 4 5 6 8 10 13 14 16 pgtbox : 1 13 pgtext : 1 2 13 pgtick : pgupdt : 16 pgvect : 15 pgvsiz : 2 4 pgvstd : 2 3 4 10 11 16 pgvw : pgwedg : 4 pgwnad : 1 2 3 4 9 11 13 pgplot/examples/pgdemo17.f010064400040640000322000000324200657056707300161620ustar00tjpcitmbr00000400000017* This program demonstrates animation and 3D geometry in PGPLOT. It * requires a fast, interactive display, e.g., /XWIN. Do not * specify a hardcopy device. The speed of the animation is limited by * the cpu speed of the host computer. * * Thanks to Dr Martin Weisser: * Date: Sun, 18 May 1997 16:14:01 CET * From: weisser@chclu.chemie.uni-konstanz.de PROGRAM PGDEM17 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. C----------------------------------------------------------------------- INTEGER PGOPEN C WRITE (*,*) 'PGPLOT: Demonstration of animation and 3D geometry' WRITE (*,*) 'Select a fast, interactive device, e.g., /XWINDOW' IF (PGOPEN('?') .LE. 0) STOP CALL POLY3D CALL PGCLOS C----------------------------------------------------------------------- END SUBROUTINE POLY3D C INTEGER NFRAMS C INTEGER NTOT, NLIN, IPOS, IFIRST REAL T, T1, T2, T3, PI, W, W1, TET, TET1, ROT, ROT1 C PARAMETER (NTOT=34) PARAMETER (T=1.618) PARAMETER (T1=1.0+T) PARAMETER (T2=-T) PARAMETER (T3=-T1) PARAMETER (W=0.60*T) PARAMETER (W1=-W) PARAMETER (TET=0.37) PARAMETER (TET1=-TET) PARAMETER (ROT=0.13) PARAMETER (ROT1=-ROT) PARAMETER (NLIN=49) C INTEGER I, J, L, III, ILINE, NTOTM6 INTEGER ICDFOR, ICCFOR, ICTFOR, ICLFOR INTEGER ICDBCK, ICCBCK, ICTBCK, ICLBCK INTEGER ITYPE(NTOT), IARRAY(NLIN), JARRAY(NLIN), LITYPE(NLIN) REAL RQ, ZZ REAL THAXI1, PHAXI1, ALFA1, THAXI2, PHAXI2, ALFA2 REAL THAXI3, PHAXI3, ALFA3, THAXI4, PHAXI4, ALFA4 REAL XOFF, YOFF, ZOFF REAL XARRAY(NTOT), YARRAY(NTOT), ZARRAY(NTOT), DISTAN(NLIN) REAL POLYS(3,NTOT), X(2), Y(2), C(3), CROT(3), RPOL(3,3) PARAMETER (PI=3.14159265359) C C Cartesian coordinates of the polygons C DATA POLYS/ T, T, T, T, T,T2, D T,T2, T, T,T2,T2, D T2, T, T, T2, T,T2, D T2,T2, T, T2,T2,T2, D T1,1.0,0.0, T1,-1.0,0.0, D T3,1.0,0.0, T3,-1.0,0.0, D 0.0,T1,1.0, 0.0,T1,-1.0, D 0.0,T3,1.0, 0.0,T3,-1.0, D 1.0,0.0,T1, -1.0,0.0,T1, D 1.0,0.0,T3, -1.0,0.0,T3, C W, W, W, W, W, W1, C W, W1, W, W, W1, W1, C W1, W, W, W1, W1, W, C W1, W, W1, W1, W1, W1, T TET, TET, TET, TET1, TET1, TET, T TET1, TET, TET1, TET, TET1, TET1, L ROT, 0.0, 0.0, ROT1, 0.0, 0.0/ C DATA ITYPE/1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, C 2,2,2,2,2,2,2,2, T 3,3,3,3, L 4,4/ C C Initialize the plot (no labels). C CALL PGENV(-3.2,3.2,-3.2,3.2,1,-2) C C Switch from page to page without typing return. C CALL PGASK(.FALSE.) C C Rotation axis of the polygons C THAXI1 = PI/4.0 PHAXI1 = PI/4.5 ALFA1 = 0.0 THAXI2 = PI/6.0 PHAXI2 = 0.0 ALFA2 = 0.02 THAXI3 = PI/2.0 PHAXI3 = -PI/3.0 ALFA3 = 0.0 THAXI4 = -0.03 PHAXI4 = PI/7.0 ALFA4 = 0.9 C XOFF=0.0 YOFF=0.0 ZOFF=0.0 NTOTM6=NTOT-6 C C Colors C ICDFOR = 3 ICDBCK = 10 C ICCFOR = 8 ICCBCK = 2 C ICTFOR = 5 ICTBCK = 4 C ICLFOR = 1 ICLBCK = 7 C IPOS=1 C WRITE(*,*)' Rotation with increasing velocity' C NFRAMS=3500 C DO 12 I=1,NTOT XARRAY(I) = POLYS(1,I) YARRAY(I) = POLYS(2,I) ZARRAY(I) = POLYS(3,I) 12 CONTINUE C DO 30 L=1,NFRAMS C CALL PGBBUF CALL PGERAS C CALL SORTPP(NTOT,ITYPE,ZARRAY,YARRAY,XARRAY) C IFIRST=0 DO 13 I=1,NTOT IF((ZARRAY(I).GE.0.0).AND.(IFIRST.EQ.0)) THEN IFIRST = 1 IPOS = I END IF 13 CONTINUE C IF(L.EQ.2800) CALL OFFSET (XOFF,YOFF,ZOFF) IF (MOD(L,500).EQ.0) THEN CALL CHNAX(THAXI3,PHAXI3,THAXI2,PHAXI2,THAXI1,PHAXI1) END IF C DO 33 I=1,IPOS-1 IF (ITYPE(I).EQ.1) THEN CALL PGSCI(ICDBCK) CALL PGSLW(18) ELSE IF (ITYPE(I).EQ.2) THEN CALL PGSCI(ICCBCK) CALL PGSLW(17) ELSE IF (ITYPE(I).EQ.3) THEN CALL PGSCI(ICTBCK) CALL PGSLW(15) ELSE CALL PGSCI(ICLBCK) CALL PGSLW(14) END IF ZZ = ZARRAY(I) CALL PGPT(1,XARRAY(I)+0.2*ZZ,YARRAY(I)+0.3*ZZ,9) 33 CONTINUE C DO 44 I=IPOS,NTOT IF (ITYPE(I).EQ.1) THEN CALL PGSCI(ICDFOR) CALL PGSLW(18) ELSE IF (ITYPE(I).EQ.2) THEN CALL PGSCI(ICCFOR) CALL PGSLW(17) ELSE IF (ITYPE(I).EQ.3) THEN CALL PGSCI(ICTFOR) CALL PGSLW(15) ELSE CALL PGSCI(ICLFOR) CALL PGSLW(14) END IF ZZ = ZARRAY(I) CALL PGPT(1,XARRAY(I)+0.2*ZZ,YARRAY(I)+0.3*ZZ,9) 44 CONTINUE C ILINE=0 C DO 2000 I=2,NTOT DO 1000 J=1,I-1 IF (ITYPE(I).EQ.ITYPE(J)) THEN RQ = 0.0 RQ = RQ + ( (XARRAY(I)-XARRAY(J))**2+ # (YARRAY(I)-YARRAY(J))**2+ # (ZARRAY(I)-ZARRAY(J))**2 ) C IF ( ((RQ-0.0676) .LT.0.001).OR. # ((RQ-1.095199).LT.0.001).OR. # ((RQ-3.769809).LT.0.001).OR. # ((RQ-4.000000).LT.0.001) ) THEN ILINE = ILINE + 1 DISTAN(ILINE) = ZARRAY(I)+ZARRAY(J) IF(DISTAN(ILINE).LT.0.0) THEN LITYPE(ILINE) = -ITYPE(I) ELSE LITYPE(ILINE) = ITYPE(I) END IF IARRAY(ILINE) = I JARRAY(ILINE) = J END IF END IF 1000 CONTINUE 2000 CONTINUE C CALL SORTLI(ILINE,DISTAN,IARRAY,JARRAY,LITYPE) C DO 3000 III=1,ILINE I=IARRAY(III) J=JARRAY(III) ZZ = ZARRAY(I) X(1) = XARRAY(I)+0.2*ZZ Y(1) = YARRAY(I)+0.3*ZZ ZZ = ZARRAY(J) X(2) = XARRAY(J)+0.2*ZZ Y(2) = YARRAY(J)+0.3*ZZ IF (LITYPE(III).GT.0) THEN IF(LITYPE(III).EQ.1) THEN CALL PGSLW(10) CALL PGSCI(ICDFOR) ELSE IF (LITYPE(III).EQ.2) THEN CALL PGSLW(8) CALL PGSCI(ICCFOR) ELSE IF (LITYPE(III).EQ.3) THEN CALL PGSLW(6) CALL PGSCI(ICTFOR) ELSE CALL PGSLW(4) CALL PGSCI(ICLFOR) END IF ELSE IF(LITYPE(III).EQ.-1) THEN CALL PGSLW(7) CALL PGSCI(ICDBCK) ELSE IF (LITYPE(III).EQ.-2) THEN CALL PGSLW(4) CALL PGSCI(ICCBCK) ELSE IF (LITYPE(III).EQ.-3) THEN CALL PGSLW(3) CALL PGSCI(ICTBCK) ELSE CALL PGSLW(2) CALL PGSCI(ICLBCK) END IF END IF CALL PGLINE(2,X,Y) 3000 CONTINUE C DO 45 I=NTOTM6,NTOT IF (ITYPE(I).EQ.1) THEN CALL PGSCI(ICDFOR) CALL PGSLW(19) ZZ = ZARRAY(I) CALL PGPT(1,XARRAY(I)+0.2*ZZ,YARRAY(I)+0.3*ZZ,9) END IF 45 CONTINUE C DO 4000 III=1,NTOT IF (ITYPE(III).EQ.1) THEN CALL POLMAT(RPOL,THAXI1,PHAXI1,ALFA1) ELSE IF (ITYPE(III).EQ.2) THEN CALL POLMAT(RPOL,THAXI2,PHAXI2,ALFA2) ELSE IF (ITYPE(III).EQ.3) THEN CALL POLMAT(RPOL,THAXI3,PHAXI3,ALFA3) ELSE CALL POLMAT(RPOL,THAXI4,PHAXI4,ALFA4) END IF C(1)=XARRAY(III) C(2)=YARRAY(III) C(3)=ZARRAY(III) CALL MMULT (C,RPOL,CROT) XARRAY(III)=CROT(1)+XOFF YARRAY(III)=CROT(2)+YOFF ZARRAY(III)=CROT(3)+ZOFF 4000 CONTINUE C ALFA1 = ALFA1+1.5E-5*(1.0+2.0*L/4000.) ALFA2 = ALFA2-2.0E-5*(1.0+4.0*L/4000.) ALFA3 = ALFA3-4.0E-5*(1.0+3.0*L/4000.) C CALL PGEBUF C 30 CONTINUE C C----------------------------------------------------------------------- END SUBROUTINE MMULT (VECTOR,RMATRX,ROTVEC) C C Matrix multiplication C REAL VECTOR(3) REAL ROTVEC(3) REAL RMATRX(3,3) C ROTVEC(1)=RMATRX(1,1)*VECTOR(1)+RMATRX(1,2)*VECTOR(2)+ # RMATRX(1,3)*VECTOR(3) ROTVEC(2)=RMATRX(2,1)*VECTOR(1)+RMATRX(2,2)*VECTOR(2)+ # RMATRX(2,3)*VECTOR(3) ROTVEC(3)=RMATRX(3,1)*VECTOR(1)+RMATRX(3,2)*VECTOR(2)+ # RMATRX(3,3)*VECTOR(3) C RETURN END SUBROUTINE POLMAT(RPOL,THAXI,PHAXI,ALFA) C REAL THAXI,PHAXI,ALFA REAL RPOL(3,3) REAL SINT,SINTQ,SINP,SINPQ,SINA REAL COST,COSTQ,COSP,COSPQ,COSA,EMCOSA C SINT = SIN(THAXI) COST = COS(THAXI) SINP = SIN(PHAXI) COSP = COS(PHAXI) SINA = SIN(ALFA) COSA = COS(ALFA) EMCOSA = 1.0-COSA C SINTQ = SINT*SINT COSTQ = COST*COST SINPQ = SINP*SINP COSPQ = COSP*COSP C RPOL(1,1) = COSA+COSPQ*SINTQ*EMCOSA RPOL(2,1) = COST*SINA+SINP*COSP*SINTQ*EMCOSA RPOL(3,1) = -SINP*SINT*SINA+SINT*COST*COSP*EMCOSA RPOL(1,2) = -COST*SINA+SINP*COSP*SINTQ*EMCOSA RPOL(2,2) = COSA+SINPQ*SINTQ*EMCOSA RPOL(2,3) = -COSP*SINT*SINA+SINP*SINT*COST*EMCOSA RPOL(1,3) = SINP*SINT*SINA+SINT*COST*COSP*EMCOSA RPOL(3,2) = COSP*SINT*SINA+COST*SINT*SINP*EMCOSA RPOL(3,3) = COSA+COSTQ*EMCOSA C RETURN END SUBROUTINE SORTPP(N,ITYPE,RA1,RA2,RA3) C REAL RA1, RA2, RA3, RRA1, RRA2, RRA3 INTEGER ITYPE(*), L, N, IR, I, J, IRRA1 DIMENSION RA1(*), RA2(*), RA3(*) L=N/2+1 IR=N 10 CONTINUE IF(L.GT.1)THEN L=L-1 RRA1=RA1(L) IRRA1=ITYPE(L) RRA2=RA2(L) RRA3=RA3(L) ELSE RRA1=RA1(IR) IRRA1=ITYPE(IR) RRA2=RA2(IR) RRA3=RA3(IR) RA1(IR)=RA1(1) ITYPE(IR)=ITYPE(1) RA2(IR)=RA2(1) RA3(IR)=RA3(1) IR=IR-1 IF(IR.EQ.1)THEN RA1(1)=RRA1 ITYPE(1)=IRRA1 RA2(1)=RRA2 RA3(1)=RRA3 RETURN ENDIF ENDIF I=L J=L+L 20 IF(J.LE.IR)THEN IF(J.LT.IR)THEN IF(RA1(J).LT.RA1(J+1))J=J+1 ENDIF IF(RRA1.LT.RA1(J))THEN RA1(I)=RA1(J) ITYPE(I)=ITYPE(J) RA2(I)=RA2(J) RA3(I)=RA3(J) I=J J=J+J ELSE J=IR+1 ENDIF GO TO 20 ENDIF RA1(I)=RRA1 ITYPE(I)=IRRA1 RA2(I)=RRA2 RA3(I)=RRA3 GO TO 10 END C SUBROUTINE SORTLI(N,RA1,IA1,IA2,IA3) C REAL RA1, RRA1 INTEGER L, N, IR, I, J, IRA1, IRA2, IRA3, IA1, IA2, IA3 DIMENSION RA1(*), IA1(*), IA2(*) , IA3(*) L=N/2+1 IR=N 10 CONTINUE IF(L.GT.1)THEN L=L-1 RRA1=RA1(L) IRA1=IA1(L) IRA2=IA2(L) IRA3=IA3(L) ELSE RRA1=RA1(IR) IRA1=IA1(IR) IRA2=IA2(IR) IRA3=IA3(IR) RA1(IR)=RA1(1) IA1(IR)=IA1(1) IA2(IR)=IA2(1) IA3(IR)=IA3(1) IR=IR-1 IF(IR.EQ.1)THEN RA1(1)=RRA1 IA1(1)=IRA1 IA2(1)=IRA2 IA3(1)=IRA3 RETURN ENDIF ENDIF I=L J=L+L 20 IF(J.LE.IR)THEN IF(J.LT.IR)THEN IF(RA1(J).LT.RA1(J+1))J=J+1 ENDIF IF(RRA1.LT.RA1(J))THEN RA1(I)=RA1(J) IA1(I)=IA1(J) IA2(I)=IA2(J) IA3(I)=IA3(J) I=J J=J+J ELSE J=IR+1 ENDIF GO TO 20 ENDIF RA1(I)=RRA1 IA1(I)=IRA1 IA2(I)=IRA2 IA3(I)=IRA3 GO TO 10 END SUBROUTINE OFFSET (XOFF,YOFF,ZOFF) C REAL XOFF,YOFF,ZOFF C WRITE(*,*)' Rotation with shifting' XOFF=-0.0002 YOFF=+0.0004 ZOFF=-0.0002 RETURN END SUBROUTINE CHNAX # (THAXI3,PHAXI3,THAXI2,PHAXI2,THAXI1,PHAXI1) C REAL THAXI1,PHAXI1,PHAXI2,THAXI2,PHAXI3,THAXI3,PI PARAMETER (PI=3.14159265359) C THAXI3 = THAXI3 - PI*0.32 PHAXI3 = PHAXI3 + PI*0.28 THAXI2 = THAXI2 + PI*0.18 PHAXI2 = PHAXI2 - PI*0.14 THAXI1 = THAXI1 - PI*0.12 PHAXI1 = PHAXI1 + PI*0.08 C RETURN END GPT(1,XARRAY(I)+0.2*ZZ,YARRAY(I)+0.3*ZZ,9) 44 CONTINUE C ILINE=0 C DO 2000 I=2,NTOT DO 1000 J=1,I-1 IF (ITYPE(I).EQ.ITYPE(J)) THEN RQ = 0.0 RQ pgplot/examples/pgdemo12.f010064400040640000322000000021220613230314200161240ustar00tjpcitmbr00000400000017 PROGRAM PGDE12 C----------------------------------------------------------------------- C Demonstration program for PGPLOT: use of PGPAP to change the C size of the view surface. C C C Note that PGPAP must be called either immediately after PGOPEN or C immediately before PGPAGE, and it affects all subsequent pages until C the next call to PGPAP. (In the following code, PGENV calls PGPAGE.) C----------------------------------------------------------------------- INTEGER PGOPEN WRITE (*,*) 'Demonstration of routine PGPAP to change the size of' WRITE (*,*) 'the view surface' WRITE (*,*) IF (PGOPEN('?') .LE. 0) STOP WRITE (*,*) 'First page: size is 7 x 3.5 inch' CALL PGPAP(7.0,0.5) CALL PGENV(0.0,1.0,0.0,2.0,0,0) CALL PGLAB('x','y','1') WRITE (*,*) 'Second page: size to 6 x 6 inch' CALL PGPAP(6.0,1.0) CALL PGENV(0.0,1.0,0.0,2.0,0,0) CALL PGLAB('x','y','2') WRITE (*,*) 'Third page: same size as second' CALL PGENV(0.0,1.0,0.0,2.0,0,0) CALL PGLAB('x','y','3') CALL PGCLOS END pgplot/examples/check010075500040640000322000000027570634703725500154010ustar00tjpcitmbr00000400000017#!/bin/sh # # Procedure to find which demo programs use each PGPLOT routine # #----------------------------------------------------------------------- PG_ROUTINES="\ pgarro\ pgask \ pgaxis\ pgaxlg\ pgband\ pgbbuf\ pgbeg \ pgbin \ pgbox \ pgbox1\ pgcirc\ pgcl \ pgclos\ pgcn01\ pgcnsc\ pgconb\ pgconf\ pgconl\ pgcons\ pgcont\ pgconx\ pgcp \ pgctab\ pgcurs\ pgdraw\ pgebuf\ pgend \ pgenv \ pgeras\ pgerrb\ pgerrx\ pgerry\ pgetxt\ pgfunt\ pgfunx\ pgfuny\ pggray\ pghi2d\ pghis1\ pghist\ pghtch\ pgiden\ pgimag\ pginit\ pglab \ pglcur\ pgldev\ pglen \ pgline\ pgmove\ pgmtxt\ pgncur\ pgnoto\ pgnpl \ pgnumb\ pgolin\ pgopen\ pgpage\ pgpanl\ pgpap \ pgpixl\ pgpnts\ pgpoly\ pgpt \ pgpt1 \ pgptxt\ pgqah \ pgqcf \ pgqch \ pgqci \ pgqcir\ pgqclp\ pgqcol\ pgqcr \ pgqcs \ pgqdt \ pgqfs \ pgqhs \ pgqid \ pgqinf\ pgqitf\ pgqls \ pgqlw \ pgqndt\ pgqpos\ pgqtbg\ pgqtxt\ pgqvp \ pgqvsz\ pgqwin\ pgrect\ pgrnd \ pgrnge\ pgsah \ pgsave\ pgscf \ pgsch \ pgsci \ pgscir\ pgsclp\ pgscr \ pgscrl\ pgscrn\ pgsfs \ pgshls\ pgshs \ pgsitf\ pgslct\ pgsls \ pgslw \ pgstbg\ pgsubp\ pgsvp \ pgswin\ pgtbox\ pgtext\ pgtick\ pgupdt\ pgvect\ pgvsiz\ pgvstd\ pgvw \ pgwedg\ pgwnad\ " for file in $PG_ROUTINES; do string="${file} :" for demo in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17; do if grep -i -w ${file} pgdemo${demo}.f >/dev/null; then string="$string $demo" fi done echo ${string} done pgplot/examples/pgdemo4.f010064400040640000322000000253620634605105600160730ustar00tjpcitmbr00000400000017 PROGRAM PGDEM4 C----------------------------------------------------------------------- C Test program for PGPLOT: test of imaging routine PGIMAG and associated C routines PGWEDG and PGCTAB. C----------------------------------------------------------------------- INTEGER PGOPEN INTEGER MXI, MXJ PARAMETER (MXI=64, MXJ=64) INTEGER I, L, C1, C2, NC REAL F(MXI,MXJ) REAL FMIN,FMAX,TR(6), CONTRA, BRIGHT, ANGLE, C, S, ALEV(1) CHARACTER*16 VAL C C Introduction. C WRITE(*,*)'Demonstration of PGIMAG and associated routines.' WRITE(*,*)'This program requires a device with color capability.' WRITE(*,*)'On an interactive device, you can modify the color map' WRITE(*,*)'used for the image.' WRITE(*,*) C C Open device for graphics. C IF (PGOPEN('?') .LT. 1) STOP CALL PGQINF('TYPE', VAL, L) WRITE (*,*) 'PGPLOT device type: ', VAL(1:L) CALL PGQCIR(C1, C2) NC = MAX(0, C2-C1+1) WRITE (*,*) 'Number of color indices used for image: ', NC IF (NC .LT.8) THEN WRITE (*,*) 'Not enough colors available on this device' STOP ELSE WRITE (*,*) END IF C C Compute a suitable function in array F. C CALL FUNC(F, MXI, MXJ, FMIN, FMAX) C C----------------------------------------------------------------------- C Example 1: simple transformation matrix C----------------------------------------------------------------------- C C Set the coordinate transformation matrix: C world coordinate = pixel number. C TR(1) = 0.0 TR(2) = 1.0 TR(3) = 0.0 TR(4) = 0.0 TR(5) = 0.0 TR(6) = 1.0 C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL SETVP CALL PGWNAD(0.0, 1.0+MXI, 0.0, 1.0+MXJ) C C Set up the color map. C BRIGHT = 0.5 CONTRA = 1.0 CALL PALETT(2, CONTRA, BRIGHT) C C Draw the map with PGIMAG. C CALL PGIMAG(F,MXI,MXJ,1,MXI,1,MXJ,FMIN,FMAX,TR) C C Annotate the plot. C CALL PGMTXT('t',1.0,0.0,0.0,'PGIMAG, PGWEDG, and PGCTAB') CALL PGSCH(0.6) CALL PGBOX('bcntsi',0.0,0,'bcntsiv',0.0,0) CALL PGMTXT('b',3.0,1.0,1.0,'pixel number') C C Draw a wedge. C CALL PGWEDG('BI', 4.0, 5.0, FMIN, FMAX, 'pixel value') CALL PGSCH(1.0) C C If the device has a cursor, allow user to fiddle with color table. C CALL PGQINF('CURSOR', VAL, L) IF (VAL(:L).EQ.'YES') THEN CALL FIDDLE CALL PGASK(.FALSE.) END IF C C----------------------------------------------------------------------- C Example 2: rotation, overlay contours. C----------------------------------------------------------------------- C C Compute the coordinate transformation matrix. The matrix is chosen C to put array element (MXI/2, MXJ/2) at (X,Y)=(0,0), and map the C entire array onto a square of side 2, rotated through angle ANGLE C radians. C ANGLE = 120.0/57.29578 C = COS(ANGLE) S = SIN(ANGLE) TR(1) = -C - S TR(2) = 2.0*C/REAL(MXI) TR(3) = 2.0*S/REAL(MXJ) TR(4) = -C + S TR(5) = (-2.0)*S/REAL(MXI) TR(6) = 2.0*C/REAL(MXJ) C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL SETVP CALL PGWNAD(-1.0, 1.0, -1.0, 1.0) CALL PGSCI(1) C C Set up the color map. C BRIGHT = 0.5 CONTRA = 1.0 CALL PALETT(2, CONTRA, BRIGHT) C C Draw the map with PGIMAG. C CALL PGIMAG(F,MXI,MXJ,1,MXI,1,MXJ,FMIN,FMAX,TR) C C Overlay contours in white. C CALL PGSCI(1) DO 40 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSLS(2) ELSE CALL PGSLS(1) END IF CALL PGCONT(F,MXI,MXJ,1,MXI,1,MXJ,ALEV,-1,TR) 40 CONTINUE CALL PGSLS(1) CALL PGSLW(1) C C Annotate the plot. C CALL PGSCI(1) CALL OUTLIN(1,MXI,1,MXJ,TR) CALL PGMTXT('t',1.0,0.0,0.0,'PGIMAG, PGCONT and PGWEDG') CALL PGSCH(0.6) CALL PGBOX('bctsn',0.0,0,'bctsn',0.0,0) C C Draw a wedge. C CALL PGWEDG('BI', 4.0, 5.0, FMIN, FMAX, 'pixel value') CALL PGSCH(1.0) C C If the device has a cursor, allow user to fiddle with color table. C CALL PGQINF('CURSOR', VAL, L) IF (VAL(:L).EQ.'YES') THEN CALL FIDDLE END IF C C Close the device and exit. C CALL PGEND C----------------------------------------------------------------------- END SUBROUTINE PALETT(TYPE, CONTRA, BRIGHT) C----------------------------------------------------------------------- C Set a "palette" of colors in the range of color indices used by C PGIMAG. C----------------------------------------------------------------------- INTEGER TYPE REAL CONTRA, BRIGHT C REAL GL(2), GR(2), GG(2), GB(2) REAL RL(9), RR(9), RG(9), RB(9) REAL HL(5), HR(5), HG(5), HB(5) REAL WL(10), WR(10), WG(10), WB(10) REAL AL(20), AR(20), AG(20), AB(20) C DATA GL /0.0, 1.0/ DATA GR /0.0, 1.0/ DATA GG /0.0, 1.0/ DATA GB /0.0, 1.0/ C DATA RL /-0.5, 0.0, 0.17, 0.33, 0.50, 0.67, 0.83, 1.0, 1.7/ DATA RR / 0.0, 0.0, 0.0, 0.0, 0.6, 1.0, 1.0, 1.0, 1.0/ DATA RG / 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.6, 0.0, 1.0/ DATA RB / 0.0, 0.3, 0.8, 1.0, 0.3, 0.0, 0.0, 0.0, 1.0/ C DATA HL /0.0, 0.2, 0.4, 0.6, 1.0/ DATA HR /0.0, 0.5, 1.0, 1.0, 1.0/ DATA HG /0.0, 0.0, 0.5, 1.0, 1.0/ DATA HB /0.0, 0.0, 0.0, 0.3, 1.0/ C DATA WL /0.0, 0.5, 0.5, 0.7, 0.7, 0.85, 0.85, 0.95, 0.95, 1.0/ DATA WR /0.0, 1.0, 0.0, 0.0, 0.3, 0.8, 0.3, 1.0, 1.0, 1.0/ DATA WG /0.0, 0.5, 0.4, 1.0, 0.0, 0.0, 0.2, 0.7, 1.0, 1.0/ DATA WB /0.0, 0.0, 0.0, 0.0, 0.4, 1.0, 0.0, 0.0, 0.95, 1.0/ C DATA AL /0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4, 0.5, : 0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9, 1.0/ DATA AR /0.0, 0.0, 0.3, 0.3, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, : 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/ DATA AG /0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.8, 0.8, : 0.6, 0.6, 1.0, 1.0, 1.0, 1.0, 0.8, 0.8, 0.0, 0.0/ DATA AB /0.0, 0.0, 0.3, 0.3, 0.7, 0.7, 0.7, 0.7, 0.9, 0.9, : 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ C IF (TYPE.EQ.1) THEN C -- gray scale CALL PGCTAB(GL, GR, GG, GB, 2, CONTRA, BRIGHT) ELSE IF (TYPE.EQ.2) THEN C -- rainbow CALL PGCTAB(RL, RR, RG, RB, 9, CONTRA, BRIGHT) ELSE IF (TYPE.EQ.3) THEN C -- heat CALL PGCTAB(HL, HR, HG, HB, 5, CONTRA, BRIGHT) ELSE IF (TYPE.EQ.4) THEN C -- weird IRAF CALL PGCTAB(WL, WR, WG, WB, 10, CONTRA, BRIGHT) ELSE IF (TYPE.EQ.5) THEN C -- AIPS CALL PGCTAB(AL, AR, AG, AB, 20, CONTRA, BRIGHT) END IF END SUBROUTINE SETVP C----------------------------------------------------------------------- C Set the viewport, allowing margins around the edge for annotation. C (This is similar in effect to PGVSTD, but has different margins.) C The routine determines the view-surface size and allocates margins C as fractions of the minimum of width and height. C----------------------------------------------------------------------- REAL D, VPX1, VPX2, VPY1, VPY2 C CALL PGSVP(0.0, 1.0, 0.0, 1.0) CALL PGQVP(1, VPX1, VPX2, VPY1, VPY2) D = MIN(VPX2-VPX1, VPY2-VPY1)/40.0 VPX1 = VPX1 + 5.0*D VPX2 = VPX2 - 2.0*D VPY1 = VPY1 + 8.0*D VPY2 = VPY2 - 2.0*D CALL PGVSIZ(VPX1, VPX2, VPY1, VPY2) END SUBROUTINE FIDDLE C INTEGER P, IER, PGCURS REAL CONTRA, BRIGHT, X, Y, SIGN REAL X1, Y1, X2, Y2, B1, B2, C1, C2 CHARACTER CH C WRITE (*,*) 'Use cursor to adjust color table:' WRITE (*,*) ' Keys 1,2,3,4,5 select different palettes' WRITE (*,*) ' Key P cycles through available palettes' WRITE (*,*) ' Key F adjusts contrast and brightness, with' WRITE (*,*) ' cursor x position setting brightness [0.0 - 1.0]' WRITE (*,*) ' and y position setting contrast [0.0 - 10.0]' WRITE (*,*) ' (Hold down F key while moving cursor to change' WRITE (*,*) ' contrast and brightness continuously)' WRITE (*,*) ' Key C resets contrast=1.0, brightness=0.5' WRITE (*,*) ' Key - reverses color palette' WRITE (*,*) ' Key X or right mouse button exits program' C P = 2 CONTRA = 1.0 BRIGHT = 0.5 X = 0.5 Y = 1.0 SIGN = +1.0 C CALL PGQWIN(X1, X2, Y1, Y2) B1 = 0.0 B2 = 1.0 C1 = 0.0 C2 = 10.0 CALL PGSWIN(B1, B2, C1, C2) 10 IER = PGCURS(X, Y, CH) IF (CH.EQ.CHAR(0) .OR. CH.EQ.'x' .OR. CH.EQ.'X') THEN CALL PGSWIN(X1, X2, Y1, Y2) RETURN ELSE IF (CH.EQ.'F' .OR. CH.EQ.'f') THEN BRIGHT = MAX(B1, MIN(B2,X)) CONTRA = MAX(C1, MIN(C2,Y)) ELSE IF (CH.EQ.'C' .OR. CH.EQ.'c') THEN CONTRA = 1.0 Y = 1.0 BRIGHT = 0.5 X = 0.5 ELSE IF (CH.EQ.'-') THEN SIGN = -SIGN ELSE IF (CH.EQ.'1') THEN P = 1 ELSE IF (CH.EQ.'2') THEN P = 2 ELSE IF (CH.EQ.'3') THEN P = 3 ELSE IF (CH.EQ.'4') THEN P = 4 ELSE IF (CH.EQ.'5') THEN P = 5 ELSE IF (CH.EQ.'P' .OR. CH.EQ.'p') THEN P = 1 + MOD(P,5) END IF CALL PALETT(P, SIGN*CONTRA, BRIGHT) GOTO 10 END SUBROUTINE FUNC(F, M, N, FMIN, FMAX) INTEGER M,N REAL F(M,N), FMIN, FMAX C INTEGER I, J REAL R C FMIN = 1E30 FMAX = -1E30 DO 20 I=1,M DO 10 J=1,N R = SQRT(REAL(I)**2 + REAL(J)**2) F(I,J) = COS(0.6*SQRT(I*80./M)-16.0*J/(3.*N))* : COS(16.0*I/(3.*M))+(I/REAL(M)-J/REAL(N)) + : 0.05*SIN(R) FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE END SUBROUTINE OUTLIN(I1,I2,J1,J2,TR) INTEGER I1,I2,J1,J2 REAL TR(6) C----------------------------------------------------------------------- C Draw the enclosing rectangle of the subarray to be contoured, C applying the transformation TR. C C For a contour map, the corners are (I1,J1) and (I2,J2); for C a gray-scale map, they are (I1-0.5,J1-0.5), (I2+0.5, J2+0.5). C----------------------------------------------------------------------- INTEGER K REAL XW(5), YW(5), T C XW(1) = I1 YW(1) = J1 XW(2) = I1 YW(2) = J2 XW(3) = I2 YW(3) = J2 XW(4) = I2 YW(4) = J1 XW(5) = I1 YW(5) = J1 DO 10 K=1,5 T = XW(K) XW(K) = TR(1) + TR(2)*T + TR(3)*YW(K) YW(K) = TR(4) + TR(5)*T + TR(6)*YW(K) 10 CONTINUE CALL PGLINE(5,XW,YW) END age.' WRITE(*,*) C C Open device for graphics. C IF (PGOPEN('?') .LT. 1) STOP CALL PGQINF('TYPE', VAL, L) WRITE (*,*) 'PGPLOT device type: ', VAL(1:L) CALL PGQCIR(C1, C2) NC = MAX(0, C2-C1+1) WRITE (*,*) 'Number of color indicespgplot/examples/pgdemo10.f010064400040640000322000000040570557044576000161550ustar00tjpcitmbr00000400000017 PROGRAM PGDE10 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. C This program shows how the default colors can be C overridden with PGSCRN (or PGSCR). On some devices (those with a color C lookup table), changing the background color (color index 0) takes C effect immediately, but on others it only affects elements that are C explicitly drawn in the background color. Thus it is necessary to fill C the page with the background color, which is here done with PGERAS, C before drawing anything else (this means that PGENV cannot be used). C----------------------------------------------------------------------- INTEGER PGBEG, I, IER REAL XS(9),YS(9), XR(101), YR(101) C C Start a new page. C WRITE (*,*) 'This program is intended for use with color displays' IF (PGBEG(0,'?',1,1) .NE. 1) STOP CALL PGPAGE C C Override default colors. C CALL PGSCRN(0, 'DarkSlateGray', IER) CALL PGSCRN(1, 'White', IER) CALL PGSCRN(2, 'Yellow', IER) CALL PGSCRN(3, 'Cyan', IER) CALL PGSCRN(4, 'SlateGray', IER) C C "Erase" the screen to fill with background color. C CALL PGERAS C C Set up window and viewport. C CALL PGSCH(1.5) CALL PGVSTD CALL PGSWIN(0.,10.,0.,0.65) C C Fill the viewport in a different color. C CALL PGSCI(4) CALL PGRECT(0., 10., 0., 0.65) C C Annotation. C CALL PGSCI(0) CALL PGBOX('G', 0.0, 0, 'G', 0.0, 0) CALL PGSCI(1) CALL PGSLW(3) CALL PGSCF(2) CALL PGBOX('BCNST', 0.0, 0, 'BCNSTV', 0.0, 0) CALL PGLAB('\fix', ' ', : '\frPGPLOT Graph: \fi y = x\u\fr2\de\u-\fix\d') C C Plot the graph. C DO 10 I=1,101 XR(I) = 0.1*(I-1) YR(I) = XR(I)**2*EXP(-XR(I)) 10 CONTINUE DO 20 I=1,9 XS(I) = I YS(I) = XS(I)**2*EXP(-XS(I)) 20 CONTINUE CALL PGSCI(2) CALL PGSLW(4) CALL PGLINE(101,XR,YR) CALL PGSCI(3) CALL PGSCH(3.0) CALL PGPT(9,XS,YS,18) C C Done. C CALL PGEND C END pgplot/examples/pgdemo15.f010064400040640000322000000071520634733125400161540ustar00tjpcitmbr00000400000017 PROGRAM PGDEM3 C----------------------------------------------------------------------- C Demonstration program for PGPLOT vector field plot. C----------------------------------------------------------------------- INTEGER PGOPEN WRITE (*,'(A)') ' Demonstration of routine PGVECT' C C Call PGBEG to initiate PGPLOT and open the output device; PGBEG C will prompt the user to supply the device name and type. C IF (PGOPEN('?') .LE. 0) STOP CALL PGEX35 CALL PGEND C----------------------------------------------------------------------- END SUBROUTINE PGEX35 C----------------------------------------------------------------------- C Program to demonstrate the use of PGVECT along with C PGCONB by illustrating the flow around a cylinder with circulation. C C NX total # of axial stations C NY total # of grid pts in y (or r) direction C----------------------------------------------------------------------- INTEGER MAXX, MAXY PARAMETER (MAXX=101,MAXY=201) INTEGER NX, NY, I, J, NC REAL PI, A, GAMMA, VINF, XMAX, XMIN, YMAX, YMIN, DX, DY REAL CPMIN, R2, BLANK REAL CP(MAXX,MAXY),X(MAXX),Y(MAXY),U(MAXX,MAXY),V(MAXX,MAXY), 1 PSI(MAXX,MAXY) REAL TR(6),C(10) PARAMETER (PI=3.14159265359) DATA BLANK/-1.E10/ C C compute the flow about a cylinder with circulation C C define various quantities C C number of points in the x and y directions NX = 31 NY = 31 C cylinder radius A = 1. C circulation strength GAMMA = 2. C freestream velocity VINF = 1. C max and min x and y XMAX = 3.*A XMIN = -3.*A YMAX = 3.*A YMIN = -3.*A C point spacing DX = (XMAX-XMIN)/(NX-1) DY = (YMAX-YMIN)/(NY-1) C compute the stream function, Cp, and u and v velocities CPMIN =1.E10 DO 20 I=1,NX X(I) = XMIN+DX*(I-1) DO 10 J=1,NY Y(J) = YMIN+DY*(J-1) R2 = X(I)**2+Y(J)**2 IF (R2.GT.0.) THEN PSI(I,J) = VINF*Y(J)*(1.-A**2/R2) 1 +GAMMA/(2.*PI)*0.5*ALOG(R2/A) U(I,J) = VINF*(1.+A**2/R2-2.*A**2*X(I)**2/R2**2) 1 +GAMMA/(2.*PI)*Y(J)/R2 V(I,J) = VINF*X(I)*(-2.*A**2*Y(J)/R2**2) 1 +GAMMA/(2.*PI)*X(I)/R2 CP(I,J) = 1.-(U(I,J)**2+V(I,J)**2)/VINF**2 ELSE PSI(I,J) = 0. U(I,J) = 0. V(I,J) = 0. CP(I,J) = 0. END IF IF (R2.LT.A**2) THEN U(I,J) = BLANK V(I,J) = BLANK ELSE CPMIN = MIN(CPMIN,CP(I,J)) END IF 10 CONTINUE 20 CONTINUE C C grid to world transformation C TR(1)=X(1)-DX TR(2)=DX TR(3)=0.0 TR(4)=Y(1)-DY TR(5)=0.0 TR(6)=DY C CALL PGENV (X(1),X(NX),Y(1),Y(NY),1,0) CALL PGIDEN CALL PGLAB ('X','Y','Flow About a Cylinder with Circulation') C C contour plot of the stream function (streamlines) C NC=5 C(1)=1. C(2)=.5 C(3)=0. C(4)=-.5 C(5)=-1. CALL PGCONT (PSI,MAXX,MAXY,1,NX,1,NY,C,NC,TR) C C draw cylinder C CALL PGBBUF CALL PGSCI (0) CALL PGSFS (1) CALL PGCIRC (0.,0.,A*1.1) CALL PGSFS (2) CALL PGSCI (14) CALL PGCIRC (0.0, 0., A) CALL PGSCI (1) CALL PGEBUF C C vector plot C CALL PGSAH (2, 45.0, 0.7) CALL PGSCH (0.3) CALL PGVECT (U,V,MAXX,MAXY,2,NX-1,2,NY-1,0.0,0,TR,-1.E10) CALL PGSCH(1.0) C C finished C RETURN C---------------------------------------------------------------------- END pgplot/examples/pgdemo5.f010064400040640000322000000051160613654767100161010ustar00tjpcitmbr00000400000017 PROGRAM PGDEM5 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. This programs shows the use of C routine PGOLIN to allow the user to draw polygons on the screen. C As each polygon is completed, it is filled in using routine PGPOLY. C The user positions the cursor to define the vertices of the polygon. C He types 'A' to add a vertex at the current cursor position, 'D' to C delete the nearest vertex, or 'X' to signal that the polygon is C complete. Two 'X's in succession terminates the program. C----------------------------------------------------------------------- INTEGER PGBEG INTEGER MAXPT, NPT, COL PARAMETER (MAXPT=50) REAL X(MAXPT),Y(MAXPT) INTEGER WHICH C 100 FORMAT(' Demonstration of PGPLOT cursor routines', 1 ' PGLCUR and PGOLIN.'/ 2 ' These routines allow you to draw polygons on the', 3 ' screen, using the'/ 4 ' cursor to mark the vertices.'/) 110 FORMAT(/' PGLCUR outlines the polygon as you draw it, PGOLIN', 1 ' just marks the'/ 2 ' vertices. Which routine do you want to use? Type 1', 3 ' for PGLCUR, 2 for'/ 4 ' PGOLIN:') 120 FORMAT(' Use the cursor to choose the vertices of the polygon'/ 1 ' Type A to add a vertex at the cursor position'/ 2 ' Type D to delete the last vertex'/ 3 ' Type X to close the polygon and shade it'/ 4 ' (Type X again to exit from the program)') C WRITE (6, 100) WRITE (6, 110) READ (5, *, ERR=10, END=10) WHICH 10 IF (WHICH.LT.1 .OR. WHICH.GT.2) WHICH = 1 WRITE (6, 120) C C Open device for graphics. C IF (PGBEG(0,'?',1,1) .NE. 1) STOP C C Clear the screen. Draw a frame at the physical extremities of the C view surface using full-screen viewport and standard window. C CALL PGPAGE CALL PGSVP(0.0,1.0,0.0,1.0) CALL PGSWIN(0.0,1.0,0.0,1.0) CALL PGBOX('BC',0.1,5,'BC',0.1,5) COL = 0 C C Increment the color index and then call PGOLIN to allow the user C to draw a polygon. C 20 COL = COL+1 CALL PGSCI(COL) NPT = 0 IF (WHICH.EQ.1) CALL PGLCUR(MAXPT,NPT,X,Y) IF (WHICH.EQ.2) CALL PGOLIN(MAXPT,NPT,X,Y,-1) C C Fill the interior of the polygon in the current color. If less C than three vertices were supplied, that is a signal to terminate C the program. Otherwise, go back and draw another polygon. C IF (NPT.GE.3) THEN CALL PGPOLY(NPT,X,Y) GOTO 20 END IF C C Close the device and exit. C CALL PGEND END pgplot/examples/pgdemo16.f010064400040640000322000000273530633616104000161520ustar00tjpcitmbr00000400000017 PROGRAM PGDE16 C C Demonstration program for bar charts (subroutine PGBCHT). C This subroutine may be included in the PGPLOT library in a future C release of PGPLOT C INTEGER PGOPEN INTEGER NCAT, NSET PARAMETER (NCAT=5, NSET=2) REAL VALS(NCAT, NSET) REAL VALS2(NCAT, 3) REAL VALS3(12) CHARACTER*12 LABS(NCAT), LABS3(12) REAL VMIN, VMAX DATA VALS /15, 2, 3, 45, 17, : 14, 1, 2, 44, 16/ DATA VALS2/15, -20, -13, 45, 17, : 14, -11, -8, 44, 16, : 12, 9, -10, 30, 12/ DATA LABS /'Antelope', 'Bear', 'Cat', 'Dog', 'Elephant'/ DATA VALS3/31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ DATA LABS3/'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', : 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/ C C Bar charts in PGPLOT C IF (PGOPEN('?').LT.1) STOP CALL PGSUBP(2,2) VMIN = 0.0 VMAX = 0.0 CALL PGPAGE CALL PGVSTD CALL PGBCHT(NCAT, 1, VALS, LABS, VMIN, VMAX, ' ', 0.7, 2) CALL PGLAB(' ', ' ', 'Bar Chart') CALL PGPAGE CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'GN', 0.7, 2) CALL PGLAB(' ', ' ', 'Grouped Bar Chart (no box)') CALL PGPAGE CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'GS', 0.7, 11) CALL PGLAB(' ', ' ', 'Stacked Bar Chart') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'G', 0.8, 5) CALL PGLAB(' ', ' ', 'Grouped Bar Chart with Negative Values') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'GS', 0.7, 5) CALL PGLAB(' ', ' ', 'Stacked Bar Chart with Negative Values') CALL PGPAGE CALL PGVSTD CALL PGBCHT(NCAT, 1, VALS, LABS, VMIN, VMAX, 'H', 0.7, 2) CALL PGLAB(' ', ' ', 'Bar Chart') CALL PGPAGE CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'HG', 0.7, 2) CALL PGLAB(' ', ' ', 'Grouped Bar Chart') CALL PGPAGE CALL PGBCHT(NCAT, 2, VALS, LABS, VMIN, VMAX, 'HGS', 0.7, 11) CALL PGLAB(' ', ' ', 'Stacked Bar Chart') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HG', 0.8, 5) CALL PGLAB(' ', ' ', 'Grouped Bar Chart with Negative Values') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HGS', 0.7, 5) CALL PGLAB(' ', ' ', 'Stacked Bar Chart with Negative Values') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'HGSF', 0.7, 7) CALL PGLAB(' ', ' ', 'Stacked Bar Chart (Hatched)') CALL PGPAGE CALL PGBCHT(NCAT, 3, VALS2, LABS, VMIN, VMAX, 'GF', 0.7, -1) CALL PGLAB(' ', ' ', 'Grouped Bar Chart (Hatched)') CALL PGPAGE CALL PGBCHT(12, 1, VALS3, LABS3, VMIN, VMAX, 'GF', 0.9, -1) CALL PGLAB(' ', ' ', 'Bar Chart (Hatched)') CALL PGPAGE CALL PGBCHT(12, 1, VALS3, LABS3, VMIN, VMAX, 'G', 0.5, 12) CALL PGLAB(' ', ' ', 'Bar Chart') CALL PGCLOS END C*PGBCHT -- draw a bar or column chart C+ SUBROUTINE PGBCHT(NCAT, NSET, VALS, LABS, VMIN, VMAX, OPT, : WIDTH, CI) INTEGER NCAT, NSET REAL VALS(NCAT,NSET) CHARACTER*(*) LABS(NCAT) REAL VMIN, VMAX CHARACTER*(*) OPT REAL WIDTH INTEGER CI C C Description to be written. C C Arguments: C NCAT (input) : number of categories, and first dimension of VALS. C NSET (input) : number of data sets (i.e., number of values to be C plotted for each category). C VALS (input) : data values: a 2-D array (a 1-D array may be used C if NSET=1). Element VALS(I,J) gives the value in C the Jth data set for category I. The first C dimension of VALS must be equal to NCAT, and the C second should equal or exceed NSET (only the first C NSET elements are used). C LABS (input) : character array, dimension at least NCAT, giving C names for the NCAT categories. C VMIN (input) : lower limit for the value axis (i.e., the vertical C axis for a vertical column chart, or the C horizontal axis for a horizontal bar chart). C VMAX (input) : upper limit for the value axis. If VMIN=VMAX=0.0, C the subroutine chooses limits automatically. C OPT (input) : a character string containing a list of one-letter C options (in any order, and case-insensitive): C F : if present, the data sets are distinguished C using different hatching styles; colors C are also used unless CI=-1 (see below). C G : if present, grid lines are drawn at major C intervals of the value axis. C H : if present, the subroutine draws a horizontal C bar chart, with categories arranged from C top to bottom; otherwise it draws a vertical C column chart, with categories arranged from C left to right. C L : if present, the value axis is labelled C logarithmically. The end point of the C bars is at value 1 (10**0) rather than zero. C This is unsatisfactory if negative values C are used. C N : if present, the box around the viewport C is omitted (but not the baseline). C S : if present, the subroutine draws a stacked C bar chart; otherwise it draws a grouped C bar chart (there is no difference between C these for a single data set, NSET=1). C WIDTH (input) : the fraction of the maximum width available for C each category that is occupied by bars. If C WIDTH=1.0, bars from adjacent categories abut. C Recommended value: 0.7 to 0.8. C CI (input) : a color index. If CI=-1, all bars are colored C using the current color index (i.e., color index C 1 unless PGSCI has been called). If CI is 0 or C positive, bars for the first data set are colored C using this color index, and bars for subsequent C data sets are colored using CI+1, CI+2, etc. C (Axes and labels always use the current color C index.) C-- C 27-Jan-97 [TJP] C----------------------------------------------------------------------- INTEGER I, J, CCI LOGICAL GRID, STACK, HORIZ, LOGAX, HATCH, NOBOX C LOGICAL PGNOTO REAL DMIN, DMAX, CMIN, CMAX, XMIN, XMAX, YMIN, YMAX REAL W, MARG, BWID, V, V1, V2, YMINN, YMINP CHARACTER L*1, NB*2 INTEGER FS(3) DATA FS/1, 3, 4/ C C Check and decode arguments. C IF (NCAT.LT.1 .OR. NSET.LT.1) RETURN W = WIDTH IF (WIDTH.GT.1.0 .OR. WIDTH.LE.0.0) THEN C CALL GRWARN('PGBCHT: WIDTH argument should be <= 1.0, > 0.0') W = 1.0 END IF C IF (PGNOTO('PGBCHT')) RETURN GRID = INDEX(OPT,'G').NE.0 .OR. INDEX(OPT,'g').NE.0 STACK = INDEX(OPT,'S').NE.0 .OR. INDEX(OPT,'s').NE.0 HORIZ = INDEX(OPT,'H').NE.0 .OR. INDEX(OPT,'h').NE.0 LOGAX = INDEX(OPT,'L').NE.0 .OR. INDEX(OPT,'l').NE.0 HATCH = INDEX(OPT,'F').NE.0 .OR. INDEX(OPT,'f').NE.0 NOBOX = INDEX(OPT,'N').NE.0 .OR. INDEX(OPT,'n').NE.0 C C Determine the data range if necessary. C DMIN = VMIN DMAX = VMAX IF (DMIN.EQ.0.0 .AND. DMAX.EQ.0.0) THEN IF (.NOT.STACK) THEN C -- Grouped bar chart DO J=1,NSET DO I=1,NCAT IF (VALS(I,J).GT.DMAX) DMAX = VALS(I,J) IF (VALS(I,J).LT.DMIN) DMIN = VALS(I,J) END DO END DO ELSE C -- Stacked bar chart C (accumulate pos and neg separately) DO I=1,NCAT V1 = 0.0 V2 = 0.0 DO J=1,NSET IF (VALS(I,J).GT.0.0) V1 = V1+VALS(I,J) IF (VALS(I,J).LT.0.0) V2 = V2+VALS(I,J) END DO IF (V1.GT.DMAX) DMAX = V1 IF (V2.LT.DMIN) DMIN = V2 END DO END IF CALL PGRNGE(DMIN, DMAX, DMIN, DMAX) END IF CMIN = 0.0 CMAX = NCAT C C Set the window. C CALL PGBBUF IF (HORIZ) THEN CALL PGSWIN(DMIN, DMAX, CMAX, CMIN) ELSE CALL PGSWIN(CMIN, CMAX, DMIN, DMAX) END IF C C Draw a grid if requested. C IF (GRID) THEN CALL PGSAVE CALL PGSCI(15) CALL PGSLW(1) CALL PGSLS(2) IF (HORIZ) THEN CALL PGBOX('G', 0.0, 0, ' ', 0.0, 0) ELSE CALL PGBOX(' ', 0.0, 0, 'G', 0.0, 0) END IF CALL PGUNSA END IF CALL PGSAVE CALL PGQCI(CCI) C C Draw the bars. C MARG = (1.0-W)*0.5 IF (.NOT.STACK) THEN C -- Grouped bar chart BWID = W/REAL(NSET) DO I=1,NCAT DO J=1,NSET V = VALS(I,J) IF (V.NE.0.0) THEN IF (CI.GE.0) CALL PGSCI(CI+J-1) CALL PGSFS(1) IF (HATCH) CALL PGSFS(FS(1+MOD(J,3))) XMIN = (I-1)+MARG+(J-1)*BWID XMAX = XMIN+BWID YMIN = 0.0 YMAX = V IF (HORIZ) THEN CALL PGRECT(YMIN, YMAX, XMIN, XMAX) ELSE CALL PGRECT(XMIN, XMAX, YMIN, YMAX) END IF CALL PGSCI(CCI) CALL PGSFS(2) IF (HORIZ) THEN CALL PGRECT(YMIN, YMAX, XMIN, XMAX) ELSE CALL PGRECT(XMIN, XMAX, YMIN, YMAX) END IF END IF END DO END DO ELSE C -- Stacked bar chart DO I=1,NCAT YMINP = 0.0 YMINN = 0.0 DO J=1,NSET V = VALS(I,J) IF (V.NE.0.0) THEN IF (CI.GE.0) CALL PGSCI(CI+J-1) CALL PGSFS(1) IF (HATCH) CALL PGSFS(FS(1+MOD(J,3))) XMIN = (I-1)+MARG XMAX = XMIN+W IF (V.LT.0.0) THEN YMIN = YMINN YMINN = YMINN+V ELSE YMIN = YMINP YMINP = YMINP+V END IF YMAX = YMIN+V IF (HORIZ) THEN CALL PGRECT(YMIN, YMAX, XMIN, XMAX) ELSE CALL PGRECT(XMIN, XMAX, YMIN, YMAX) END IF CALL PGSCI(CCI) CALL PGSFS(2) IF (HORIZ) THEN CALL PGRECT(YMIN, YMAX, XMIN, XMAX) ELSE CALL PGRECT(XMIN, XMAX, YMIN, YMAX) END IF END IF END DO END DO END IF C C Draw the axes, and a baseline if necessary. C CALL PGSCI(CCI) L = ' ' IF (LOGAX) L= 'L' NB = 'BC' IF (NOBOX) NB = ' ' IF (HORIZ) THEN CALL PGBOX('NST'//NB//L, 0.0, 0, 'ATP'//NB, 1.0, 1) ELSE CALL PGBOX('ATP'//NB, 1.0, 1, 'NSTV'//L//NB, 0.0, 0) END IF C C Label the categories. C CALL PGUPDT DO I=1,NCAT IF (HORIZ) THEN CALL PGMTXT('LV', 0.5, 1.0-(I-0.5)/REAL(NCAT), 1.0, LABS(I)) ELSE CALL PGMTXT('B', 1.2, (I-0.5)/REAL(NCAT), 0.5, LABS(I)) END IF END DO C C Done. C CALL PGUNSA CALL PGEBUF RETURN END the subroutine chooses limits automatically. C OPT (input) : a character string containing a list of one-letter C options (in any order, and case-insensitive): C F : if present, the data sets are distinguished C pgplot/examples/pgdemo7.f010064400040640000322000000174400576743613700161110ustar00tjpcitmbr00000400000017 PROGRAM PGDEM7 C C Demonstration program for 3D surface plotting routine FREDDY. C INTEGER PGBEG REAL A(51,51), R, SIZE INTEGER I, J C IF (PGBEG(0, '?', 1, 1) .NE. 1) THEN STOP END IF C C Calculate a sample data array. C DO 20 I=1,51 DO 10 J=1,51 R = (I-26)**2 + (J-26)**2 R = 0.5*SQRT(R) IF (R.GT.0.0) THEN A(I,J) = SIN(R)/R ELSE A(I,J) = 1.0 END IF 10 CONTINUE 20 CONTINUE C C FREDDY assumes the window is square of size SIZE. C SIZE = 1.0 CALL PGENV(0., SIZE, 0., SIZE, 1, -2) CALL FREDDY(A,51,51, SIZE, 25.0) CALL PGEND END C----------------------------------------------------------------------- SUBROUTINE FREDDY(ARRAY,KX,NY,SIZE,ANGLE) INTEGER KX, NY REAL ARRAY(KX,NY), SIZE, ANGLE C C Draws isometric plot of array C REAL FMAX,FMIN,DELTAX,DELTAY,DELTAV,SINE,PEAK,X,DX,HEIGHT INTEGER I,J,KI,KJ,NX,MX,MY,STEP,LEFT,RIGHT,IT,MN,INCX LOGICAL VISBLE COMMON /FREDCM/ DELTAX,X,STEP,LEFT,RIGHT,IT,NX,VISBLE C MN = KX*NY NX = KX C Check array size: IF(NX.LT.2 .OR. NY.LT.2) RETURN FMAX = ARRAY(1,1) FMIN = FMAX DO 20 J=1,NY DO 10 I=1,NX FMIN = AMIN1(ARRAY(I,J),FMIN) FMAX = AMAX1(ARRAY(I,J),FMAX) 10 CONTINUE 20 CONTINUE DELTAX = SIZE/(NX+NY) SINE = SIN(ANGLE/58.) DELTAY = DELTAX*SINE HEIGHT = SIZE*(1.-ABS(SINE)) DELTAV = HEIGHT FMAX = FMAX-FMIN IF(FMAX.LT.0.0001) FMAX = DELTAV DELTAV = DELTAV/FMAX MX = NX+1 MY = NY+1 STEP = MX C C Start PGPLOT buffering. C CALL PGBBUF C C Work our way down the Y axis, then up the X axis, C calculating the Y plotter coordinates for each C column of the plot, doing the hidden-line suppression C at the same time. C DO 50 J=1,NY KJ = MY-J KI = 1 C ( KI,KJ are coordinates of bottom of column) ARRAY(KI,KJ) = DELTAY*(KI+KJ) + DELTAV*(ARRAY(KI,KJ)-FMIN) 30 PEAK = ARRAY(KI,KJ) 40 KI = KI+1 KJ = KJ+1 IF(KI.GT.NX .OR. KJ.GT.NY) GOTO 50 ARRAY(KI,KJ) = DELTAY*(KI+KJ) + DELTAV*(ARRAY(KI,KJ)-FMIN) IF(ARRAY(KI,KJ).GT.PEAK) GOTO 30 IF(ARRAY(KI,KJ).LE.PEAK) ARRAY(KI,KJ) = -ABS(ARRAY(KI,KJ)) GOTO 40 50 CONTINUE C C Now to work our way up the X axis C DO 80 I=2,NX KI = I KJ = 1 ARRAY(KI,KJ) = DELTAY*(KI+KJ)+DELTAV*(ARRAY(KI,KJ)-FMIN) 60 PEAK = ARRAY(KI,KJ) 70 KI = KI+1 KJ = KJ+1 IF(KI.GT.NX .OR. KJ.GT.NY) GOTO 80 ARRAY(KI,KJ) = DELTAY*(KI+KJ)+DELTAV*(ARRAY(KI,KJ)-FMIN) IF(ARRAY(KI,KJ).GT.PEAK) GOTO 60 IF(ARRAY(KI,KJ).LE.PEAK) ARRAY(KI,KJ) = -ABS(ARRAY(KI,KJ)) GOTO 70 80 CONTINUE C C Draw a line along the bottom of the vertical faces C CALL PGMOVE(DELTAX*(NX+NY-2), DELTAY*(MX)) CALL PGDRAW(DELTAX*(NY-1), DELTAY*2) CALL PGDRAW(0.0, DELTAY*MY) C C Array is now ready for plotting. If a point is C positive, then it is to be plotted at that Y C coordinate; if it is negative, then it is C invisible, but at minus that Y coordinate (the point C where the line heading towards it disappears has to C be determined by finding the intersection of it and C the cresting line). C C Plot rows: C DO 110 J=1,NY,2 KJ = MY-J DX = DELTAX*(J-2) X = DX+DELTAX CALL PGMOVE(X,DELTAY*(KJ+1)) CALL PGDRAW(X,ARRAY(1,KJ)) VISBLE = .TRUE. DO 90 I=2,NX RIGHT = I+NX*(KJ-1) LEFT = RIGHT-1 IT = RIGHT X = DX+DELTAX*I CALL FREDGO(ARRAY,MN) 90 CONTINUE C C Now at far end of row so come back C KJ = KJ-1 IF(KJ.LE.0) GOTO 170 VISBLE = ARRAY(NX,KJ).GE.0.0 DX = DELTAX*(NX+J) IF(VISBLE) CALL PGMOVE(DX-DELTAX,ARRAY(NX,KJ)) DELTAX = -DELTAX DO 100 I=2,NX KI = MX-I LEFT = KI+NX*(KJ-1) RIGHT = LEFT+1 IT = LEFT X = DX+DELTAX*I CALL FREDGO(ARRAY,MN) 100 CONTINUE C X = DX+DELTAX*NX IF(.NOT.VISBLE) CALL PGMOVE(X,ARRAY(1,KJ)) CALL PGDRAW(X,DELTAY*(KJ+1)) C (set DELTAX positive for return trip) DELTAX = -DELTAX 110 CONTINUE C C Now do the columns: C as we fell out of the last DO-loop we do the C columns in ascending-X order C INCX = 1 KI = 1 C (set DELTAX -ve since scanning R to L) 120 DX = DELTAX*(KI+NY-1) DELTAX = -DELTAX X = DX+DELTAX CALL PGMOVE(X,ARRAY(1,1)) 130 VISBLE = .TRUE. DO 140 J=2,NY LEFT = KI+NX*(J-1) RIGHT = LEFT-NX IT = LEFT X = DX+DELTAX*J CALL FREDGO(ARRAY,MN) 140 CONTINUE C C At far end, increment X and check still inside array C KI = KI+INCX IF(KI.LE.0 .OR. KI.GT.NX) GOTO 180 VISBLE = ARRAY(KI,NY).GE.0.0 DELTAX = -DELTAX DX = DELTAX*(KI-2) X = DX+DELTAX IF(VISBLE) CALL PGMOVE(X,ARRAY(KI,NY)) DO 150 J=2,NY KJ = MY-J RIGHT = KI+NX*(KJ-1) LEFT = RIGHT+NX IT = RIGHT X = DX+DELTAX*J CALL FREDGO(ARRAY,MN) 150 CONTINUE C X = DX+DELTAX*NY IF(.NOT.VISBLE) CALL PGMOVE(X,ARRAY(KI,1)) IF(KI.EQ.1) GOTO 180 CALL PGDRAW(X,DELTAY*(KI+1)) KI = KI+INCX IF(KI.GT.NX) GOTO 180 IF(KI.EQ.1) GOTO 120 160 DELTAX = -DELTAX DX = DELTAX*(1-KI-NY) X = DX+DELTAX CALL PGMOVE(X,DELTAY*(KI+1)) CALL PGDRAW(X,ARRAY(KI,1)) GOTO 130 C C Do columns backwards because ended rows at far end of X C 170 KI = NX INCX = -1 DX = DELTAX*(KI+NY) GOTO 160 C C 180 CALL PGEBUF END C----------------------------------------------------------------------- SUBROUTINE FREDGO(ARRAY,MN) INTEGER MN REAL ARRAY(MN) C INTEGER STEP,LEFT,RIGHT,IT,NX LOGICAL VISBLE REAL AL,AR,BL,EM,XX,X,Y,DELTAX COMMON /FREDCM/ DELTAX,X,STEP,LEFT,RIGHT,IT,NX,VISBLE C C Test visibility C IF(ARRAY(IT).LT.0.0) GOTO 80 C C This point is visible - was last? C IF(VISBLE) GOTO 50 C C No: calculate point where this line vanishes C 10 IF(LEFT.LE.NX .OR. MOD(LEFT-1,NX).EQ.0 .OR. 1 RIGHT.LE.NX .OR. MOD(RIGHT-1,NX).EQ.0) GOTO 100 AL = ABS(ARRAY(LEFT)) AR = ABS(ARRAY(RIGHT)) IF(ARRAY(LEFT).LT.0.0) GOTO 70 C Right-hand point is crested 20 RIGHT = RIGHT-STEP IF(ARRAY(RIGHT).LT.0.0) GOTO 20 C Left-hand end of cresting line is either C RIGHT+NX or RIGHT-1 LEFT = RIGHT+NX IF(ARRAY(LEFT).LT.0.0) LEFT = RIGHT-1 C C RIGHT and LEFT index into the endpoints of the C cresting line 30 BL = ABS(ARRAY(LEFT)) EM = ABS(ARRAY(RIGHT))-BL XX = EM-AR+AL IF(ABS(XX).LT.0.0001) GOTO 60 XX = (AL-BL)/XX 40 Y = EM*XX+BL IF(DELTAX.GT.0.0) XX = 1.0-XX XX = X-XX*DELTAX IF(VISBLE) GOTO 90 C Drawing a line from an invisible point C to a visible one CALL PGMOVE(XX,Y) VISBLE = .TRUE. 50 CALL PGDRAW(X,ARRAY(IT)) RETURN C 60 XX = 0.5 GOTO 40 C C Left-hand point crested C 70 LEFT = LEFT-STEP IF(ARRAY(LEFT).LT.0.0) GOTO 70 C C Right-hand end of cresting line is either LEFT+1 or LEFT-NX C RIGHT = LEFT+1 IF(ARRAY(RIGHT).LT.0.0) RIGHT = LEFT-NX GOTO 30 C C This point is invisible; if last one was too, then forget it; C else draw a line towards it C 80 IF(.NOT.VISBLE) RETURN GOTO 10 C 90 CALL PGDRAW(XX,Y) 100 VISBLE = .FALSE. RETURN END IF(ARRAY(KI,KJ).LE.PEAK) ARRAY(KI,KJ) = -ABS(ARRAY(KI,KJ)) GOTO 70 80 CONTINUE C C Draw a line along the bottom of the vertical faces C CALL PGMOVE(DELTAX*(NX+NY-2), DELTAY*(MX)) CALL PGDRAW(DEpgplot/examples/pgdemo8.f010064400040640000322000000167310566046057000161020ustar00tjpcitmbr00000400000017 PROGRAM PGDEM8 C C From: Philip Palmer C Date: Mon, 26 Nov 90 12:27:22 GMT C C This program plots a 3d surface using PGSURF. C INTEGER NCURVE PARAMETER(NCURVE=21) INTEGER I,J, PGBEG REAL A(NCURVE,NCURVE),XLIMS(3,2) REAL AA1,AA2,AA3,AA4 REAL X,Y,DX,DY,THD,PHD,Q REAL POT COMMON/COEFS/AA1,AA2,AA3,AA4 C THD=40. PHD=-35. Q=0.1 AA1=60./17.-24.*Q/17. AA2=12./17. AA3=52./17. AA4=24./17. XLIMS(1,1)=0. XLIMS(1,2)=0.43 XLIMS(2,1)=-1.5 XLIMS(2,2)=1.5 XLIMS(3,1)=0. XLIMS(3,2)=1. DX=(XLIMS(1,2)-XLIMS(1,1))/(NCURVE-1) DY=(XLIMS(2,2)-XLIMS(2,1))/(NCURVE-1) DO 1 I=1,NCURVE X=XLIMS(1,1)+(I-1)*DX DO 2 J=1,NCURVE Y=XLIMS(2,1)+(J-1)*DY A(I,J)=POT(X,Y) 2 CONTINUE 1 CONTINUE IF (PGBEG(0,'?',1,1) .NE. 1) STOP CALL PGSURF(A,NCURVE,NCURVE,XLIMS,THD,PHD) CALL PGEND END REAL FUNCTION POT(X,Y) REAL X,Y C REAL X2,Y2,XX,YY REAL AA1,AA2,AA3,AA4 COMMON/COEFS/AA1,AA2,AA3,AA4 C Y2=Y*Y X2=12.*X*X XX=.5*(Y2+X2) YY=Y2/3.+Y*X2 POT=1.-AA1*XX-AA2*YY+AA3*XX*XX+AA4*XX*YY RETURN END SUBROUTINE PGSURF(A,NX,NY,XLIMS,THD,PHD) INTEGER NX,NY REAL A(NX,NY),XLIMS(3,2),THD,PHD C C This routine plots a 3d surface projected onto a 2D plane. C The underside of the surface appears dotted or in blue, on C clour terminals. This routine does the projection for you, C you just need to specify the viewing direction in terms of C spherical polar angles. As a result, this routine calls C pgwind for you. C C Arguments: C a (input) : data array, equally spaced in x and equally C spaced in y, although steps in x and y may C differ. C nx (input) : dimension of data array in x direction. C ny (input) : dimension of data array in y direction. C xlims (input): array of min and max values in x, y and z C respectively. C thd (input) : viewing direction given as spherical theta angle C in degrees. 0<= thd <= 90. C phd (input) : viewing direction given as spherical phi angle C in degrees. -180 <= phd <= 180. C INTEGER I,J,K,N,IFLAG,I0,I1,NSTART,NLINE,ISGN,JSGN INTEGER IMAX,JMAX,K0,K1 REAL DTOR, TH,PH,CTH,STH,CPH,SPH REAL XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,Z1,Z2,Q1,Q2,Q3 REAL A1,A2,A3,A4,B1,B2,B3,B4,XSTART,YSTART REAL XPMIN,XPMAX,YPMIN,YPMAX,DX,DY,ZZ,T REAL XA(2),YA(2),ZA(2) COMMON/PGSRF1/CTH,STH,CPH,SPH,NLINE,NSTART,IFLAG C IFLAG=0 CALL PGQCOL(I0,I1) IF(I1.NE.1) IFLAG=1 CALL PGBBUF DTOR=0.0174533 TH=THD*DTOR PH=PHD*DTOR CTH=COS(TH) STH=SIN(TH) CPH=COS(PH) SPH=SIN(PH) XMIN=XLIMS(1,1) XMAX=XLIMS(1,2) YMIN=XLIMS(2,1) YMAX=XLIMS(2,2) ZMIN=XLIMS(3,1) ZMAX=XLIMS(3,2) C C Calculate plotting order from C viewing orientation C Z1=ZMIN*STH Z2=ZMAX*STH IF(PHD.GT.0.) THEN A1=-XMAX*SPH A2=-XMIN*SPH B3=-YMAX*SPH*CTH B4=-YMIN*SPH*CTH YSTART=YMAX ISGN=-1 ELSE A1=-XMIN*SPH A2=-XMAX*SPH B3=-YMIN*SPH*CTH B4=-YMAX*SPH*CTH YSTART=YMIN ISGN=1 ENDIF IF(ABS(PHD).LT.90.) THEN B1=YMIN*CPH B2=YMAX*CPH A3=-XMAX*CPH*CTH A4=-XMIN*CPH*CTH XSTART=XMAX JSGN=-1 ELSE B1=YMAX*CPH B2=YMIN*CPH A3=-XMIN*CPH*CTH A4=-XMAX*CPH*CTH XSTART=XMIN JSGN=1 ENDIF XPMIN=MIN(A1,B1) XPMAX=MAX(A2,B2) YPMAX=MAX(A4,B4,Z2) YPMIN=MIN(A3,B3,Z1) CALL WINDOW(XPMIN,XPMAX,YPMIN,YPMAX) C C Draw coordinate axes C NSTART=0 NLINE=1 XA(1)=0. XA(2)=0. YA(1)=YMIN YA(2)=YMAX CALL PROJ(XA,YA,XA,1,1) NLINE=1 YA(1)=XMIN YA(2)=XMAX CALL PROJ(YA,XA,XA,1,1) NLINE=1 YA(1)=ZMIN YA(2)=ZMAX CALL PROJ(XA,XA,YA,1,1) C C Draw curves stepped in x C IMAX=NX-1 JMAX=NY-1 DX=JSGN*(XMAX-XMIN)/IMAX DY=(YMAX-YMIN)/JMAX Q1=DX*STH*SPH Q2=DY*STH*CPH Q3=DX*DY*CTH IF(JSGN.EQ.1) THEN K0=1 ELSE K0=NX ENDIF DO 1 I=0,IMAX NSTART=0 NLINE=1 XA(1)=XSTART+I*DX XA(2)=XA(1) K=K0+JSGN*I DO 2 J=0,JMAX-1 YA(1)=YMIN+J*DY YA(2)=YA(1)+DY ZA(1)=A(K,J+1) ZA(2)=A(K,J+2) K1=K+JSGN IF(K1.GE.1.AND.K1.LE.NX) THEN ZZ=A(K1,J+1) ELSE K1=K-JSGN ZZ=2.*ZA(1)-A(K1,J+1) ENDIF T=Q3-Q2*(ZZ-ZA(1))-Q1*(ZA(2)-ZA(1)) T=JSGN*T IF(T.GT.0.) THEN N=1+IFLAG ELSE N=4 ENDIF CALL PROJ(XA,YA,ZA,N,NX) 2 CONTINUE 1 CONTINUE C C Draw curves stepped in y C DY=ISGN*DY DX=JSGN*DX Q1=JSGN*Q1 Q2=ISGN*Q2 Q3=ISGN*JSGN*Q3 IF(ISGN.EQ.1) THEN K0=1 ELSE K0=NY ENDIF DO 3 J=0,JMAX NSTART=0 NLINE=1 YA(1)=YSTART+J*DY YA(2)=YA(1) K=K0+ISGN*J DO 4 I=0,IMAX-1 XA(1)=XMIN+I*DX XA(2)=XA(1)+DX ZA(1)=A(I+1,K) ZA(2)=A(I+2,K) K1=K+ISGN IF(K1.GE.1.AND.K1.LE.NY) THEN ZZ=A(I+1,K1) ELSE K1=K-ISGN ZZ=2.*ZA(1)-A(I+1,K1) ENDIF T=Q3-Q1*(ZZ-ZA(1))-Q2*(ZA(2)-ZA(1)) T=ISGN*T IF(T.GT.0.) THEN N=1+IFLAG ELSE N=4 ENDIF CALL PROJ(XA,YA,ZA,N,NY) 4 CONTINUE 3 CONTINUE CALL PGEBUF RETURN END SUBROUTINE PROJ(X,Y,Z,N,NCURVE) REAL X(2),Y(2),Z(2) INTEGER N, NCURVE C REAL XP(100),YP(100) REAL CTH,STH,CPH,SPH INTEGER NLINE,NSTART,IFLAG,M COMMON/PGSRF1/CTH,STH,CPH,SPH,NLINE,NSTART,IFLAG SAVE M IF(NLINE.EQ.1) THEN XP(1)=Y(1)*CPH-X(1)*SPH YP(1)=Z(1)*STH-(X(1)*CPH+Y(1)*SPH)*CTH XP(2)=Y(2)*CPH-X(2)*SPH YP(2)=Z(2)*STH-(X(2)*CPH+Y(2)*SPH)*CTH IF(N.NE.M) THEN M=N IF(IFLAG.EQ.0) THEN CALL PGSLS(N) ELSE CALL PGSCI(N) ENDIF ENDIF NLINE=2 ELSE IF(N.NE.M) THEN CALL PGLINE(NLINE,XP,YP) NSTART=NSTART+NLINE-1 M=N IF(IFLAG.EQ.0) THEN CALL PGSLS(N) ELSE CALL PGSCI(N) ENDIF XP(1)=XP(NLINE) YP(1)=YP(NLINE) NLINE=1 ENDIF NLINE=NLINE+1 XP(NLINE)=Y(2)*CPH-X(2)*SPH YP(NLINE)=Z(2)*STH-(X(2)*CPH+Y(2)*SPH)*CTH ENDIF IF(NLINE+NSTART.GE.NCURVE) CALL PGLINE(NLINE,XP,YP) RETURN END SUBROUTINE WINDOW(XMIN,XMAX,YMIN,YMAX) REAL XMIN, XMAX, YMIN, YMAX C C This subroutine sets up the standard pgwind, but with a C cream background. It can be ported to any program. C CALL PGPAGE CALL PGSCR(0,216/255.,216/255.,191/255.) CALL PGERAS CALL PGSWIN(XMIN,XMAX,YMIN,YMAX) CALL PGSCI(1) RETURN END CALL PGEND END REAL pgplot/examples/pgdemo9.f010064400040640000322000000042760546005571100160770ustar00tjpcitmbr00000400000017 PROGRAM PGDEM9 C----------------------------------------------------------------------- C Test program for PGPLOT: test of imaging routine PGPIXL. C----------------------------------------------------------------------- INTEGER PGBEG INTEGER N, NCOL, NLEV PARAMETER (N=64, NCOL=32, NLEV=9) INTEGER I,J,CI1,CI2 REAL F(N,N),FMIN,FMAX,R,G,B,CLEV(NLEV),TR(6) INTEGER IA(N,N) C C Compute a suitable function. C FMIN = F(1,1) FMAX = F(1,1) DO 20 I=1,N DO 10 J=1,N F(I,J) = COS(0.6*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/REAL(N) FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE DO 25 I=1,N DO 24 J=1,N IA(I,J) = (F(I,J)-FMIN)/(FMAX-FMIN)*(NCOL-1)+16 24 CONTINUE 25 CONTINUE C C Open plot device and set up coordinate system. We will plot the C image within a unit square. C IF (PGBEG(0,'?',1,1) .NE. 1) STOP CALL PGQCOL(CI1, CI2) IF (CI2.LT. 15+NCOL) THEN WRITE (*,*) 'This program requires a device with at least', 1 15+NCOL,' colors' STOP END IF CALL PGPAGE CALL PGSCR(0, 0.0, 0.3, 0.2) CALL PGSVP(0.05,0.95,0.05,0.95) CALL PGWNAD(0.0, 1.0, 0.0, 1.0) C C Set up a color palette using NCOL indices from 16 to 15+NCOL. C DO 30 I=1,NCOL R = REAL(I-1)/REAL(NCOL-1)*0.8 + 0.2 G = MAX(0.0, 2.0*REAL(I-1-NCOL/2)/REAL(NCOL-1)) B = 0.2 + 0.4*REAL(NCOL-I)/REAL(NCOL) CALL PGSCR(I+15, R, G, B) 30 CONTINUE C C Use PGPIXL to plot the image. C CALL PGPIXL(IA,N,N, 1, N, 1, N, 0.0, 1.0, 0.0, 1.0) C C Annotation. C CALL PGSCI(1) CALL PGMTXT('t',1.0,0.0,0.0,'Test of PGPIXL') CALL PGBOX('bcnts',0.0,0,'bcnts',0.0,0) C C Overlay a contour map. C TR(1) = -1.0/REAL(N-1) TR(2) = 1.0/REAL(N-1) TR(3) = 0.0 TR(4) = -1.0/REAL(N-1) TR(5) = 0.0 TR(6) = 1.0/REAL(N-1) DO 40 I=1,NLEV CLEV(I) = FMIN + (FMAX-FMIN)*REAL(I)/REAL(NLEV) 40 CONTINUE CALL PGCONT(F, N, N, 1, N, 1, N, CLEV, NLEV, TR) C C Done. C CALL PGEND END pgplot/examples/pgdemo11.f010064400040640000322000000060200634733174000161410ustar00tjpcitmbr00000400000017 PROGRAM PGDE11 C----------------------------------------------------------------------- C Demonstration program for PGPLOT: travelling sine wave. C C This program illustrates how animated displays can be generated with C PGPLOT, although PGPLOT is not optimized for such use. C C To create an animated display: C C (1) Do not call PGPAGE (or PGENV, which calls PGPAGE) between frames; C (2) Enclose all the calls required to generate each frame between C PGBBUF and PGEBUF calls; C (3) Either: erase the entire previous frame by calling PGERAS before C drawing the next frame; or: erase the parts of the frame that C have changed by overwriting with the background color (color C index 0). C C This program demonstrated both approaches. Using PGERAS is usually C slower, because more has to be redrawn in each frame. Erasing selected C parts of the display can be faster, but it may be difficult to avoid C erasing parts that should remain visible. C C This program requires an interactive display that supports writing C in color index 0. C----------------------------------------------------------------------- C Parameters: C NT is the number of frames in the animation. INTEGER N,NT REAL PI,A,B PARAMETER (N = 50) PARAMETER (NT = 100) PARAMETER (PI=3.14159265359) PARAMETER (A = 2.0*PI/N) PARAMETER (B = 2.0*PI/NT) C Variables: REAL X(0:N), Y(0:N) INTEGER I, T, L CHARACTER*8 STR INTEGER PGBEG C----------------------------------------------------------------------- WRITE (*,*) 'Demonstration of animation with PGPLOT' WRITE (*,*) 'This program requires an interactive display that' WRITE (*,*) 'supports writing in color index 0.' IF (PGBEG(0,'?',1,1) .NE. 1) STOP CALL PGQINF('HARDCOPY', STR, L) IF (STR(:L).NE.'NO') WRITE (*,*) : 'Warning: device is not interactive' WRITE (*,*) '1: erasing the entire screen between frames' CALL PGPAGE CALL PGVSTD CALL PGWNAD(-A, A*(N+1), -1.1, 1.1) DO 200 T=0,NT CALL PGBBUF CALL PGERAS CALL PGSCI(1) CALL PGBOX('bcnst', 0.0, 0, 'bcnst', 0.0, 0) DO 100 I=0,N X(I) = I*A Y(I) = SIN(I*A-T*B) 100 CONTINUE CALL PGSCI(3) CALL PGLINE(N+1,X,Y) WRITE (STR,'(I8)') T CALL PGMTXT('T', 2.0, 0.0, 0.0, STR) CALL PGEBUF 200 CONTINUE CALL PGPAGE WRITE (*,*) '2: erasing only the line between frames' CALL PGVSTD CALL PGWNAD(-A, A*(N+1), -1.1, 1.1) CALL PGBBUF CALL PGSCI(1) CALL PGBOX('bcnst', 0.0, 0, 'bcnst', 0.0, 0) DO 300 I=0,N X(I) = I*A Y(I) = SIN(I*A) 300 CONTINUE CALL PGEBUF DO 500 T=0,NT CALL PGBBUF CALL PGSCI(0) CALL PGLINE(N+1,X,Y) CALL PGSCI(3) DO 400 I=0,N X(I) = I*A Y(I) = SIN(I*A-T*B) 400 CONTINUE CALL PGLINE(N+1,X,Y) CALL PGEBUF 500 CONTINUE CALL PGEND END pgplot/examples/pgdemo2.f010064400040640000322000000343100634741224400160630ustar00tjpcitmbr00000400000017 PROGRAM PGDEM2 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. The main program opens the output C device and calls a series of subroutines, one for each sample plot. C----------------------------------------------------------------------- INTEGER PGOPEN 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. C IF (PGOPEN('?') .LE. 0) STOP C C Call the demonstration subroutines. C CALL PGEX21 CALL PGEX22 CALL PGEX23 CALL PGEX24 CALL PGEX25 CALL PGEX26 C C Finally, call PGCLOS to terminate things properly. C CALL PGCLOS C----------------------------------------------------------------------- END SUBROUTINE PGEX21 C----------------------------------------------------------------------- C Test subroutine for PGPLOT: screen alignment and color palette. C----------------------------------------------------------------------- INTEGER I, L1, L2 REAL X1, X2, Y1, Y2 CHARACTER*80 GTYPE, GVER C C Get PGPLOT information. C CALL PGQINF('VERSION', GVER, L1) CALL PGQINF('TYPE', GTYPE, L2) CALL PGBBUF C C Alignment test: clear the screen, and draw a box and grid using C three monochrome intensities (color indices 1, 14, and 15). The C plot uses the largest available square viewport and and unit window. C CALL PGPAGE CALL PGSVP(0.0,1.0,0.0,1.0) CALL PGWNAD(0.0,1.0,0.0,1.0) CALL PGSCI(14) CALL PGBOX('g',0.02,1,'g',0.02,1) CALL PGSCI(15) CALL PGBOX('g',0.1,5,'g',0.1,5) CALL PGSCI(1) CALL PGBOX('bc',0.1,5,'bc',0.1,5) C C Color palette test. C DO 20 I=0,15 CALL PGSCI(I) X1 = 0.31 + MOD(I,4)*0.1 Y1 = 0.61 - (I/4)*0.1 X2 = X1 + 0.08 Y2 = Y1 + 0.08 CALL PGRECT(X1, X2, Y1, Y2) 20 CONTINUE C C Write the device type on the plot. C CALL PGSCI(0) CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97) CALL PGSCI(1) CALL PGSFS(2) CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97) CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1)) CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2)) C CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX22 C----------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. C Plot a table of the standard PGPLOT graph marker symbols. This C program also illustrates how windows and viewports may be manipulated. C----------------------------------------------------------------------- CHARACTER*2 LABEL INTEGER NX, NY, N, IX, JY, LW REAL X, X1, X2, XOFF, Y, Y1, Y2, YOFF, DX, DY REAL XPIX1, XPIX2, YPIX1, YPIX2, RES C C Determine size of view surface. C Lower left corner is (X1,Y1), upper right (X2, Y2) [inches]. C CALL PGPAGE CALL PGSVP(0.0, 1.0, 0.0, 1.0) CALL PGQVP(1, X1, X2, Y1, Y2) X = X2-X1 Y = Y2-Y1 C C Determine device resolution (pixels/inch), and use it to choose C line width. C CALL PGQVP(3, XPIX1, XPIX2, YPIX1, YPIX2) RES = ABS(XPIX2-XPIX1)/ABS(X) LW = 1 IF (RES.GT.166.0) LW = 2 C C Choose horizontal or vertical arrangement depending on C device aspect ratio. C IF (X.GT.Y) THEN NX = 8 NY = 5 ELSE NX = 5 NY = 8 END IF DX = MIN(X/NX, 0.95*Y/NY) DY = DX IX = NX JY = 1 XOFF = X1 + (X-NX*DX)*0.5 YOFF = Y1 + (0.95*Y-NY*DY)*0.5 CALL PGBBUF C C Each symbol will be drawn in a standard window; the window is moved C by manipulating the viewport. C CALL PGSWIN(-1.,1.,-1.,1.) C C Loop through all known symbols (N=0-31 and -1 to -8). C DO 10 N=0,39 IF (N.LE.31) WRITE (LABEL,'(I2)') N IF (N.GT.31) WRITE (LABEL,'(I2)') 31-N C C Define window and viewport. The loop allows the plot to extend over C more than one page if necessary; each page is labelled at the top. C IX = IX+1 IF (IX.GT.NX) THEN IX = 1 JY = JY-1 END IF IF (JY.LT.1) THEN JY = NY IF (N.NE.0) CALL PGPAGE CALL PGSCH(1.2) CALL PGVSIZ(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY) CALL PGSLW(LW) CALL PGMTXT('T', 1.0, 0.5, 0.5, 1 '\fiPGPLOT \frMarker Symbols') END IF CALL PGVSIZ(XOFF+(IX-1)*DX, XOFF+IX*DX, 1 YOFF+(JY-1)*DY, YOFF+JY*DY) C C Call PGBOX to draw a box and PGMTXT to label it. C CALL PGSLW(1) CALL PGBOX('BC',10.0,0,'BC',10.0,0) CALL PGSCH(0.5) CALL PGMTXT('T',-1.5,0.05,0.0,LABEL) C C Call PGPT1 to draw the symbol. C CALL PGSLW(LW) CALL PGSCH(1.5) IF (N.LE.31) CALL PGPT1(0.0,0.0,N) IF (N.GT.31) CALL PGPT1(0.0,0.0,31-N) 10 CONTINUE C CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX23 C----------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. C----------------------------------------------------------------------- INTEGER N PARAMETER (N=9) INTEGER I REAL X1, Y1 CHARACTER*80 SAMPLE(N) DATA SAMPLE/ 1 'Normal: \fnABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW', 2 'Roman: \frABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW', 3 'Italic: \fiABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW', 4 'Script: \fsABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW', 5 '\fif\fr(\fix\fr) = \fix\fr\u2\dcos(2\gp\fix\fr)e\u\fix\fr\u2', 6 '\fiH\d0\u \fr= 75 \(2233) 25 km s\u-1\d Mpc\u-1\d', 7 '\fsL/L\d\(2281)\u\fr = 5\.6 \x 10\u6\d (\gl1216\A)', 8 'Markers: 3=\m3, 8=\m8, 12=\m12, 28=\m28.', 9 'Cyrillic: \(2830)\(2912)\(2906)\(2911)\(2919)\(2917)\(2915).'/ C C Call PGENV to initialize the viewport and window. C Call PGLAB to label the graph. C CALL PGENV(0.,20.,REAL(N),0.,0,-2) CALL PGLAB(' ',' ','\fiPGPLOT \frFonts') C C Use PGTEXT to write the sample character strings. C CALL PGSCH(1.6) DO 10 I=1,N X1 = 0.0 Y1 = REAL(I)-0.5 CALL PGTEXT(X1, Y1, SAMPLE(I)) 10 CONTINUE CALL PGSCH(1.0) C----------------------------------------------------------------------- END SUBROUTINE PGEX24 C----------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates the different line widths. C T. J. Pearson 1982 Dec 28 C---------------------------------------------------------------------- INTEGER IW REAL X(2), Y(2) C C Call PGENV to initialize the viewport and window. C CALL PGBBUF CALL PGENV(0.,15.,0.,15.,0,0) C C Call PGLAB to label the graph. C CALL PGLAB('Line Width',' ','\fiPGPLOT \frLine Widths') C C Draw 14 oblique lines in different thicknesses. C DO 10 IW=1,14 X(1) = IW Y(1) = 0.0 X(2) = 0.0 Y(2) = IW CALL PGSLW(IW) CALL PGLINE(2,X,Y) 10 CONTINUE C C Draw another set of lines, dashed instead of solid. C CALL PGSLS(2) DO 20 IW=1,14 X(1) = IW Y(1) = 15.0 X(2) = 15.0 Y(2) = IW CALL PGSLW(IW) CALL PGLINE(2,X,Y) 20 CONTINUE C CALL PGSLS(1) CALL PGSLW(1) CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX25 C----------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This program C tests polygon clipping on polygons and circles, and tests that C markers are clipped correctly. Note that markers exactly on the edge C of the window are supposed to be visible. C T. J. Pearson 1994 Nov 25 C----------------------------------------------------------------------- INTEGER I, J REAL PX(43), PY(43), SX(5), SY(5), RX(3), RY(3) DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3, 1 17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0, 2 28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1, 3 25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0, 4 10.0, 8.0, 6.1, 4.2, 3.0, 1.3 / DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4, 1 9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9, 2 13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5, 3 9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7, 4 0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 / DATA SX / 10.0, 10.0, 20.0, 30.0, 15.0 / DATA SY / 0.0, -6.0, -6.0, 5.0, -3.5 / DATA RX / 26.0, 27.0, 26.0 / DATA RY / -4.0, -3.0, -3.0 / C CALL PGPAGE CALL PGVSTD CALL PGBBUF CALL PGSAVE C C Set window. C CALL PGWNAD(5.0, 25.0, -5.0, 15.0) CALL PGSCI(1) CALL PGSLW(1) CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0) C C Test clipping of polygons and circles C CALL PGSFS(1) CALL PGSCI(2) CALL PGPOLY(43, PX, PY) CALL PGSCI(0) CALL PGSFS(3) CALL PGSHS(30.0, 2.0, 0.0) CALL PGPOLY(43, PX, PY) CALL PGSCI(1) CALL PGSHS(30.0, 4.0, 0.25) CALL PGPOLY(43, PX, PY) CALL PGSCI(1) CALL PGSFS(2) CALL PGPOLY(43, PX, PY) C CALL PGSFS(1) CALL PGSCI(4) CALL PGPOLY(5, SX, SY) CALL PGSCI(0) CALL PGSFS(4) CALL PGSHS(0.0, 1.6, 0.0) CALL PGPOLY(5, SX, SY) CALL PGSCI(1) CALL PGSFS(2) CALL PGPOLY(5, SX, SY) C C The next polygon should be invisible. CALL PGSFS(1) CALL PGSCI(4) CALL PGPOLY(3, RX, RY) CALL PGSCI(1) CALL PGSFS(2) CALL PGPOLY(3, RX, RY) C CALL PGSFS(1) CALL PGSCI(3) CALL PGCIRC(8.0, 12.0, 3.5) CALL PGSFS(2) CALL PGSCI(1) CALL PGCIRC(8.0, 12.0, 3.5) C C Test clipping of markers: all should be visible. C CALL PGSCI(1) CALL PGSLW(1) DO 20 I=0,30,5 DO 10 J=-5,25,5 CALL PGPT1(REAL(I),REAL(J),9) 10 CONTINUE 20 CONTINUE C C Draw box. C CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0) CALL PGLAB(' ', ' ', 'PGPLOT: clipping polygons and markers') C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX26 C----------------------------------------------------------------------- CHARACTER*128 DEVICE CHARACTER*80 GTYPE, GVER INTEGER I, J, L, L1, L2 REAL X, X1, X2, Y, Y1, Y2, R, XI, XP, YP REAL PX(43), PY(43) DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3, 1 17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0, 2 28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1, 3 25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0, 4 10.0, 8.0, 6.1, 4.2, 3.0, 1.3 / DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4, 1 9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9, 2 13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5, 3 9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7, 4 0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 / C CALL PGQINF('DEV/TYPE', DEVICE, L) CALL PGQINF('VERSION', GVER, L1) CALL PGQINF('TYPE', GTYPE, L2) CALL PGBBUF C C Clear the screen; set background and foreground colors. C CALL PGPAGE CALL PGSCR(0,0.0,0.0,0.35) CALL PGSCR(1,1.0,1.0,1.0) CALL PGERAS C C Draw a frame at the physical extremities of the plot. C Dimensions are X by Y (inches). C CALL PGSVP(0.0, 1.0, 0.0, 1.0) CALL PGQVP(1, X1, X2, Y1, Y2) X = X2-X1 Y = Y2-Y1 CALL PGSWIN(0.0, X, 0.0, Y) CALL PGSFS(2) CALL PGRECT(0.0, X, 0.0, Y) CALL PGMOVE(0.5*X, 0.0) CALL PGDRAW(0.5*X, Y) CALL PGMOVE(0.0, 0.5*Y) CALL PGDRAW(X, 0.5*Y) C C Draw a circle of diameter 0.5 x min(x,y) C R = 0.25*MIN(X,Y) CALL PGCIRC(X*0.5, Y*0.5, R) C C Draw some more circles with different line-styles; this tests C the dashing algorithm on curved lines. C CALL PGSLS(2) CALL PGCIRC(X*0.5, Y*0.5, R*1.1) CALL PGSLS(3) CALL PGCIRC(X*0.5, Y*0.5, R*1.2) CALL PGSLS(2) CALL PGSLW(3) CALL PGCIRC(X*0.5, Y*0.5, R*1.3) CALL PGSLS(1) CALL PGSLW(1) C C Demonstrate different line-styles C DO 10 I=1,5 CALL PGSLS(I) CALL PGMOVE(I*(X/20.0),0.0) CALL PGDRAW(I*(X/20.0),Y) 10 CONTINUE CALL PGSLS(1) C C Demonstrate different line-widths C DO 20 I=1,5 CALL PGSLW(I) CALL PGMOVE(0.0, I*(Y/20.0)) CALL PGDRAW(X, I*(Y/20.0)) 20 CONTINUE CALL PGSLW(1) C C Demonstrate different line-colors C CALL PGSLW(4) DO 40 I=0,15 CALL PGSCI(I) XI = (I+20)*(X/40.0) CALL PGMOVE(XI,0.0) CALL PGDRAW(XI,Y) 40 CONTINUE CALL PGSCI(1) CALL PGSLW(1) C C Draw dots in different thicknesses. C XP = (14+20)*(X/40.0) DO 30 I=1,21 YP = I*Y/22.0 CALL PGSLW(I) CALL PGPT1(XP,YP,-1) 30 CONTINUE CALL PGSLW(1) C C Demonstrate fill area C DO 50 J=1,43 PX(J) = (PX(J)+50.0)/100.0*X PY(J) = (PY(J)+75.0)/100.0*Y 50 CONTINUE DO 70 I=0,3 CALL PGSCI(I) CALL PGSFS(1) CALL PGPOLY(43,PX,PY) CALL PGSCI(1) CALL PGSFS(2) CALL PGPOLY(43,PX,PY) DO 60 J=1,43 PY(J) = PY(J)-0.25*Y 60 CONTINUE 70 CONTINUE C C Write the device type on the plot. C CALL PGSWIN(0.0, 1.0, 0.0, 1.0) CALL PGSFS(1) CALL PGSCI(0) CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97) CALL PGSCI(1) CALL PGSFS(2) CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97) CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1)) CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2)) C CALL PGEBUF C----------------------------------------------------------------------- END JY = NY IF (N.NE.0) CALL PGPAGE CALL PGSCH(1.2) CALL PGVSIZ(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY) CALL PGSLW(LW) CALL PGMTXT('T', 1.0, 0.5, 0.5, 1 '\fiPGPLOT \frMarker Symbols') END IF CALL PGVSIZ(XOFF+(IX-1)pgplot/examples/pgdemo14.f010064400040640000322000000206560614020211100161330ustar00tjpcitmbr00000400000017 PROGRAM PGDE14 C----------------------------------------------------------------------- C Demonstration program for PGPLOT: text input with PGRSTR. C C This program illustrates how an interactive program can be written C using PGPLOT. The program displays a number of active fields. Select C one of these fields using the cursor (e.g., click the mouse) to C activate it; then use the keyboard keys to edit the string displayed C in the field. Two of the fields have immediate action: 'DRAW' draws C a simple picture using the parameters specified in the input fields; C 'EXIT' terminates the program. C C A version of the subroutine used here, PGRSTR, may be included in a C future release of the PGPLOT library. C----------------------------------------------------------------------- INTEGER NBOX PARAMETER (NBOX=5) REAL BOX(4,NBOX), X, Y, XX, YY, A, D, XV(100), YV(100) INTEGER IVAL(NBOX) INTEGER PGOPEN, LSTR, I, JUNK, PGCURS, J, NV, BC, FC, CTOI INTEGER II, JJ CHARACTER CH CHARACTER*30 LABEL(NBOX), VALUE(NBOX), RESULT(NBOX) C DATA BOX /0.44, 0.8, 0.79, 0.83, : 0.44, 0.8, 0.69, 0.73, : 0.44, 0.8, 0.59, 0.63, : 0.44, 0.7, 0.29, 0.33, : 0.44, 0.7, 0.19, 0.23/ DATA LABEL /'Number of vertices:', : 'Background Color:', : 'Foreground Color:', : ' ', : ' '/ DATA VALUE /'13', : '0', : '1', : 'DRAW', : 'EXIT'/ C----------------------------------------------------------------------- WRITE (*,*) 'This program requires an interactive device.' WRITE (*,*) 'It presents a menu with editable fields which can be' WRITE (*,*) 'used to set parameters controlling a graph displayed' WRITE (*,*) 'beside the menu. To edit a field, first select it' WRITE (*,*) 'with the cursor (e.g., click mouse button) then use' WRITE (*,*) 'keyboard keys and DEL or ^U. TAB or CR terminates' WRITE (*,*) 'editing Click on DRAW to display the graph or EXIT' WRITE (*,*) 'to terminate the program.' WRITE (*,*) C C Open device for graphics. C IF (PGOPEN('?') .LE. 0) STOP CALL PGPAP(10.0,0.5) IVAL(1) = 13 IVAL(2) = 0 IVAL(3) = 1 C C Clear the screen. Draw a frame at the physical extremities of the C plot, using full-screen viewport and standard window. C CALL PGPAGE CALL PGSVP(0.0,1.0,0.0,1.0) CALL PGSWIN(0.0,2.0,0.0,1.0) CALL PGSCR(0, 0.4, 0.4, 0.4) C C Display fields C 5 WRITE(VALUE(1), '(I6)') IVAL(1) WRITE(VALUE(2), '(I6)') IVAL(2) WRITE(VALUE(3), '(I6)') IVAL(3) CALL PGSAVE CALL PGBBUF CALL PGERAS CALL PGSCI(1) CALL PGSLW(1) CALL PGSFS(1) CALL PGSCH(1.2) DO 10 I=1,NBOX RESULT(I) = VALUE(I) X = BOX(1,I) - 0.04 Y = BOX(3,I) + 0.01 CALL PGSCI(1) CALL PGPTXT(X, Y, 0.0, 1.0, LABEL(I)) CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I)) X = BOX(1,I) + 0.01 CALL PGSCI(2) CALL PGPTXT(X, Y, 0.0, 0.0, VALUE(I)) 10 CONTINUE C C Draw picture C NV = MIN(100,IVAL(1)) BC = IVAL(2) FC = IVAL(3) CALL PGSCI(BC) CALL PGSFS(1) CALL PGRECT(1.05,1.95,0.05,0.95) CALL PGSCI(FC) CALL PGSFS(2) CALL PGRECT(1.05,1.95,0.05,0.95) IF (NV.GT.3) THEN D = 360.0/NV A = -D DO 120 II=1,NV A = A+D XV(II) = 1.5 + 0.4*COS(A/57.29577951) YV(II) = 0.5 + 0.4*SIN(A/57.29577951) 120 CONTINUE C DO 140 II=1,NV-1 DO 130 JJ=II+1,NV CALL PGMOVE(XV(II),YV(II)) CALL PGDRAW(XV(JJ),YV(JJ)) 130 CONTINUE 140 CONTINUE END IF CALL PGEBUF CALL PGUNSA C C Cursor loop: user selects a box C CALL PGSLW(2) CALL PGSFS(2) XX = 0.5 YY = 0.5 DO 60 J=1,1000 JUNK = PGCURS(XX, YY, CH) IF (ICHAR(CH).EQ.0) GOTO 50 C C Find which box and highlight it C DO 30 I=1,NBOX IF (BOX(1,I).LE.XX .AND. BOX(2,I).GE.XX .AND. : BOX(3,I).LE.YY .AND. BOX(4,I).GE.YY) THEN CALL PGSCI(2) CALL PGSLW(2) CALL PGSCH(1.2) CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I)) CALL PGSLW(1) IF (I.EQ.5) THEN C -- EXIT box GOTO 50 ELSE IF (I.EQ.4) THEN C -- DRAW box GOTO 5 ELSE C C Read value C IF (RESULT(I).EQ.' ') THEN LSTR = 0 ELSE DO 11 II=LEN(RESULT(I)),1,-1 LSTR = II IF (RESULT(I)(II:II).NE.' ') GOTO 12 11 CONTINUE LSTR = 0 12 CONTINUE END IF X = BOX(1,I) + 0.01 Y = BOX(3,I) + 0.01 CALL PGRSTR(X, Y, 0.0, 0.0, RESULT(I), LSTR, 1) II = 1 IVAL(I) = CTOI(RESULT(I)(1:LSTR), II) END IF CALL PGSLW(2) CALL PGSCI(1) CALL PGRECT(BOX(1,I), BOX(2,I), BOX(3,I), BOX(4,I)) CALL PGSLW(1) END IF 30 CONTINUE 60 CONTINUE C C Close the device and exit. C 50 CONTINUE CALL PGCLOS END SUBROUTINE PGRSTR(X, Y, ANGLE, FJUST, TEXT, LSTR, BCI) REAL X, Y, ANGLE, FJUST CHARACTER*(*) TEXT INTEGER LSTR, BCI C----------------------------------------------------------------------- CHARACTER CH INTEGER JUNK, PGBAND, CI REAL XCUR, YCUR, XBOX(4), YBOX(4) C CALL PGQCI(CI) C 10 CONTINUE C -- Draw current string IF (LSTR.GT.0) THEN CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR)) CALL PGQTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR), XBOX, YBOX) XCUR = XBOX(4) YCUR = YBOX(4) ELSE XCUR = X YCUR = Y END IF C -- Read a character JUNK = PGBAND(0, 1, XCUR, YCUR, XCUR, YCUR, CH) C -- Erase old string CALL PGSCI(BCI) IF (LSTR.GT.0) : CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR)) CALL PGSCI(CI) C -- Avoid problem with PGPLOT escape character IF (CH.EQ.CHAR(92)) CH = '*' C -- Backspace (ctrl H) or delete removes last character IF (ICHAR(CH).EQ.8 .OR. ICHAR(CH).EQ.127) THEN IF (LSTR.GT.0) TEXT(LSTR:LSTR) = ' ' IF (LSTR.GT.0) LSTR = LSTR-1 C -- Ctrl U removes entire string ELSE IF (ICHAR(CH).EQ.21) THEN TEXT(1:LSTR) = ' ' LSTR = 0 C -- Any other non-printing character terminates input ELSE IF (ICHAR(CH).LT.32) THEN IF (LSTR.GT.0) : CALL PGPTXT(X, Y, ANGLE, FJUST, TEXT(1:LSTR)) GOTO 20 C -- Otherwise, add character to string if there is room ELSE IF (LSTR.LT.LEN(TEXT)) THEN LSTR = LSTR+1 TEXT(LSTR:LSTR) = CH END IF GOTO 10 C 20 RETURN END INTEGER FUNCTION CTOI (S, I) CHARACTER*(*) S INTEGER I C C Attempt to read an integer from a character string, and return C the result. No attempt is made to avoid integer overflow. A valid C integer is any sequence of decimal digits. C C Returns: C CTOI : the value of the integer; if the first character C read is not a decimal digit, the value returned C is zero. C Arguments: C S (input) : character string to be parsed. C I (in/out) : on input, I is the index of the first character C in S to be examined; on output, either it points C to the next character after a valid integer, or C it is equal to LEN(S)+1. C----------------------------------------------------------------------- INTEGER K CHARACTER*1 DIGITS(0:9) DATA DIGITS/'0','1','2','3','4','5','6','7','8','9'/ C CTOI = 0 10 IF (I.GT.LEN(S)) RETURN IF (S(I:I).EQ.' ') THEN I = I+1 GOTO 10 END IF DO 20 K=0,9 IF (S(I:I).EQ.DIGITS(K)) GOTO 30 20 CONTINUE RETURN 30 CTOI = CTOI*10 + K I = I+1 GOTO 10 END , click mouse button) then use' WRITE (*,*) 'keyboard keys and DEL or ^U. TApgplot/examples/pgdemo1.f010064400040640000322000000747640634733237700161130ustar00tjpcitmbr00000400000017 PROGRAM PGDEM1 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. The main program opens the output C device and calls a series of subroutines, one for each sample plot. C----------------------------------------------------------------------- INTEGER PGOPEN 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 Print information about device. C CALL PGEX0 C C Call the demonstration subroutines (4,5 are put on one page) C CALL PGEX1 CALL PGEX2 CALL PGEX3 CALL PGSUBP(2,1) CALL PGEX4 CALL PGEX5 CALL PGSUBP(1,1) CALL PGEX6 CALL PGEX7 CALL PGEX8 CALL PGEX9 CALL PGEX10 CALL PGEX11 CALL PGEX12 CALL PGEX13 CALL PGEX14 CALL PGEX15 C C Finally, call PGCLOS to terminate things properly. C CALL PGCLOS C----------------------------------------------------------------------- END SUBROUTINE PGEX0 C----------------------------------------------------------------------- C This subroutine tests PGQINF and displays the information returned on C the standard output. C----------------------------------------------------------------------- CHARACTER*64 VALUE INTEGER LENGTH REAL X, Y, X1, X2, Y1, Y2 C C Information available from PGQINF: C CALL PGQINF('version', VALUE, LENGTH) WRITE (*,*) 'version=', VALUE(:LENGTH) CALL PGQINF('state', VALUE, LENGTH) WRITE (*,*) 'state=', VALUE(:LENGTH) CALL PGQINF('user', VALUE, LENGTH) WRITE (*,*) 'user=', VALUE(:LENGTH) CALL PGQINF('now', VALUE, LENGTH) WRITE (*,*) 'now=', VALUE(:LENGTH) CALL PGQINF('device', VALUE, LENGTH) WRITE (*,*) 'device=', VALUE(:LENGTH) CALL PGQINF('file', VALUE, LENGTH) WRITE (*,*) 'file=', VALUE(:LENGTH) CALL PGQINF('type', VALUE, LENGTH) WRITE (*,*) 'type=', VALUE(:LENGTH) CALL PGQINF('dev/type', VALUE, LENGTH) WRITE (*,*) 'dev/type=',VALUE(:LENGTH) CALL PGQINF('hardcopy', VALUE, LENGTH) WRITE (*,*) 'hardcopy=',VALUE(:LENGTH) CALL PGQINF('terminal', VALUE, LENGTH) WRITE (*,*) 'terminal=',VALUE(:LENGTH) CALL PGQINF('cursor', VALUE, LENGTH) WRITE (*,*) 'cursor=', VALUE(:LENGTH) C C Get view surface dimensions: C CALL PGQVSZ(1, X1, X2, Y1, Y2) X = X2-X1 Y = Y2-Y1 WRITE (*,100) X, Y, X*25.4, Y*25.4 100 FORMAT (' Plot dimensions (x,y; inches): ',F9.2,', ',F9.2/ 1 ' (mm): ',F9.2,', ',F9.2) C----------------------------------------------------------------------- END SUBROUTINE PGEX1 C----------------------------------------------------------------------- C This example illustrates the use of PGENV, PGLAB, PGPT, PGLINE. C----------------------------------------------------------------------- INTEGER I REAL XS(5),YS(5), XR(100), YR(100) DATA XS/1.,2.,3.,4.,5./ DATA YS/1.,4.,9.,16.,25./ C C Call PGENV to specify the range of the axes and to draw a box, and C PGLAB to label it. The x-axis runs from 0 to 10, and y from 0 to 20. C CALL PGENV(0.,10.,0.,20.,0,1) CALL PGLAB('(x)', '(y)', 'PGPLOT Example 1: y = x\u2') C C Mark five points (coordinates in arrays XS and YS), using symbol C number 9. C CALL PGPT(5,XS,YS,9) C C Compute the function at 60 points, and use PGLINE to draw it. C DO 10 I=1,60 XR(I) = 0.1*I YR(I) = XR(I)**2 10 CONTINUE CALL PGLINE(60,XR,YR) C----------------------------------------------------------------------- END SUBROUTINE PGEX2 C----------------------------------------------------------------------- C Repeat the process for another graph. This one is a graph of the C sinc (sin x over x) function. C----------------------------------------------------------------------- INTEGER I REAL XR(100), YR(100) C CALL PGENV(-2.,10.,-0.4,1.2,0,1) CALL PGLAB('(x)', 'sin(x)/x', $ 'PGPLOT Example 2: Sinc Function') DO 20 I=1,100 XR(I) = (I-20)/6. YR(I) = 1.0 IF (XR(I).NE.0.0) YR(I) = SIN(XR(I))/XR(I) 20 CONTINUE CALL PGLINE(100,XR,YR) C----------------------------------------------------------------------- END SUBROUTINE PGEX3 C---------------------------------------------------------------------- C This example illustrates the use of PGBOX and attribute routines to C mix colors and line-styles. C---------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) INTEGER I REAL XR(360), YR(360) REAL ARG C C Call PGENV to initialize the viewport and window; the C AXIS argument is -2, so no frame or labels will be drawn. C CALL PGENV(0.,720.,-2.0,2.0,0,-2) CALL PGSAVE C C Set the color index for the axes and grid (index 5 = cyan). C Call PGBOX to draw first a grid at low brightness, and then a C frame and axes at full brightness. Note that as the x-axis is C to represent an angle in degrees, we request an explicit tick C interval of 90 deg with subdivisions at 30 deg, as multiples of C 3 are a more natural division than the default. C CALL PGSCI(14) CALL PGBOX('G',30.0,0,'G',0.2,0) CALL PGSCI(5) CALL PGBOX('ABCTSN',90.0,3,'ABCTSNV',0.0,0) C C Call PGLAB to label the graph in a different color (3=green). C CALL PGSCI(3) CALL PGLAB('x (degrees)','f(x)','PGPLOT Example 3') C C Compute the function to be plotted: a trig function of an C angle in degrees, computed every 2 degrees. C DO 20 I=1,360 XR(I) = 2.0*I ARG = XR(I)/180.0*PI YR(I) = SIN(ARG) + 0.5*COS(2.0*ARG) + 1 0.5*SIN(1.5*ARG+PI/3.0) 20 CONTINUE C C Change the color (6=magenta), line-style (2=dashed), and line C width and draw the function. C CALL PGSCI(6) CALL PGSLS(2) CALL PGSLW(3) CALL PGLINE(360,XR,YR) C C Restore attributes to defaults. C CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX4 C----------------------------------------------------------------------- C Demonstration program for PGPLOT: draw histograms. C----------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) INTEGER I, ISEED REAL DATA(1000), X(620), Y(620) REAL PGRNRM C C Call PGRNRM to obtain 1000 samples from a normal distribution. C ISEED = -5678921 DO 10 I=1,1000 DATA(I) = PGRNRM(ISEED) 10 CONTINUE C C Draw a histogram of these values. C CALL PGSAVE CALL PGHIST(1000,DATA,-3.1,3.1,31,0) C C Samples from another normal distribution. C DO 15 I=1,200 DATA(I) = 1.0+0.5*PGRNRM(ISEED) 15 CONTINUE C C Draw another histogram (filled) on same axes. C CALL PGSCI(15) CALL PGHIST(200,DATA,-3.1,3.1,31,3) CALL PGSCI(0) CALL PGHIST(200,DATA,-3.1,3.1,31,1) CALL PGSCI(1) C C Redraw the box which may have been clobbered by the histogram. C CALL PGBOX('BST', 0.0, 0, ' ', 0.0, 0) C C Label the plot. C CALL PGLAB('Variate', ' ', $ 'PGPLOT Example 4: Histograms (Gaussian)') C C Superimpose the theoretical distribution. C DO 20 I=1,620 X(I) = -3.1 + 0.01*(I-1) Y(I) = 0.2*1000./SQRT(2.0*PI)*EXP(-0.5*X(I)*X(I)) 20 CONTINUE CALL PGLINE(620,X,Y) CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX5 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates how to draw a log-log plot. C PGPLOT subroutines demonstrated: C PGENV, PGERRY, PGLAB, PGLINE, PGPT, PGSCI. C---------------------------------------------------------------------- INTEGER RED, GREEN, CYAN PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (CYAN=5) INTEGER NP PARAMETER (NP=15) INTEGER I REAL X, YLO(NP), YHI(NP) REAL FREQ(NP), FLUX(NP), XP(100), YP(100), ERR(NP) DATA FREQ / 26., 38., 80., 160., 178., 318., 1 365., 408., 750., 1400., 2695., 2700., 2 5000., 10695., 14900. / DATA FLUX / 38.0, 66.4, 89.0, 69.8, 55.9, 37.4, 1 46.8, 42.4, 27.0, 15.8, 9.09, 9.17, 2 5.35, 2.56, 1.73 / DATA ERR / 6.0, 6.0, 13.0, 9.1, 2.9, 1.4, 1 2.7, 3.0, 0.34, 0.8, 0.2, 0.46, 2 0.15, 0.08, 0.01 / C C Call PGENV to initialize the viewport and window; the AXIS argument C is 30 so both axes will be logarithmic. The X-axis (frequency) runs C from 0.01 to 100 GHz, the Y-axis (flux density) runs from 0.3 to 300 C Jy. Note that it is necessary to specify the logarithms of these C quantities in the call to PGENV. We request equal scales in x and y C so that slopes will be correct. Use PGLAB to label the graph. C CALL PGSAVE CALL PGSCI(CYAN) CALL PGENV(-2.0,2.0,-0.5,2.5,1,30) CALL PGLAB('Frequency, \gn (GHz)', 1 'Flux Density, S\d\gn\u (Jy)', 2 'PGPLOT Example 5: Log-Log plot') C C Draw a fit to the spectrum (don't ask how this was chosen). This C curve is drawn before the data points, so that the data will write C over the curve, rather than vice versa. C DO 10 I=1,100 X = 1.3 + I*0.03 XP(I) = X-3.0 YP(I) = 5.18 - 1.15*X -7.72*EXP(-X) 10 CONTINUE CALL PGSCI(RED) CALL PGLINE(100,XP,YP) C C Plot the measured flux densities: here the data are installed with a C DATA statement; in a more general program, they might be read from a C file. We first have to take logarithms (the -3.0 converts MHz to GHz). C DO 20 I=1,NP XP(I) = ALOG10(FREQ(I))-3.0 YP(I) = ALOG10(FLUX(I)) 20 CONTINUE CALL PGSCI(GREEN) CALL PGPT(NP, XP, YP, 17) C C Draw +/- 2 sigma error bars: take logs of both limits. C DO 30 I=1,NP YHI(I) = ALOG10(FLUX(I)+2.*ERR(I)) YLO(I) = ALOG10(FLUX(I)-2.*ERR(I)) 30 CONTINUE CALL PGERRY(NP,XP,YLO,YHI,1.0) CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX6 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 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 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----------------------------------------------------------------------- END SUBROUTINE PGEX7 C----------------------------------------------------------------------- C A plot with a large number of symbols; plus test of PGERR1. C----------------------------------------------------------------------- INTEGER I, ISEED REAL XS(300),YS(300), XR(101), YR(101), XP, YP, XSIG, YSIG REAL PGRAND, PGRNRM C C Window and axes. C CALL PGBBUF CALL PGSAVE CALL PGSCI(1) CALL PGENV(0.,5.,-0.3,0.6,0,1) CALL PGLAB('\fix', '\fiy', 'PGPLOT Example 7: scatter plot') C C Random data points. C ISEED = -45678921 DO 10 I=1,300 XS(I) = 5.0*PGRAND(ISEED) YS(I) = XS(I)*EXP(-XS(I)) + 0.05*PGRNRM(ISEED) 10 CONTINUE CALL PGSCI(3) CALL PGPT(100,XS,YS,3) CALL PGPT(100,XS(101),YS(101),17) CALL PGPT(100,XS(201),YS(201),21) C C Curve defining parent distribution. C DO 20 I=1,101 XR(I) = 0.05*(I-1) YR(I) = XR(I)*EXP(-XR(I)) 20 CONTINUE CALL PGSCI(2) CALL PGLINE(101,XR,YR) C C Test of PGERR1/PGPT1. C XP = XS(101) YP = YS(101) XSIG = 0.2 YSIG = 0.1 CALL PGSCI(5) CALL PGSCH(3.0) CALL PGERR1(5, XP, YP, XSIG, 1.0) CALL PGERR1(6, XP, YP, YSIG, 1.0) CALL PGPT1(XP,YP,21) C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX8 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. This program shows some of the C possibilities for overlapping windows and viewports. C T. J. Pearson 1986 Nov 28 C----------------------------------------------------------------------- INTEGER I REAL XR(720), YR(720) C----------------------------------------------------------------------- C Color index: INTEGER BLACK, WHITE, RED, GREEN, BLUE, CYAN, MAGENT, YELLOW PARAMETER (BLACK=0) PARAMETER (WHITE=1) PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (BLUE=4) PARAMETER (CYAN=5) PARAMETER (MAGENT=6) PARAMETER (YELLOW=7) C Line style: INTEGER FULL, DASHED, DOTDSH, DOTTED, FANCY PARAMETER (FULL=1) PARAMETER (DASHED=2) PARAMETER (DOTDSH=3) PARAMETER (DOTTED=4) PARAMETER (FANCY=5) C Character font: INTEGER NORMAL, ROMAN, ITALIC, SCRIPT PARAMETER (NORMAL=1) PARAMETER (ROMAN=2) PARAMETER (ITALIC=3) PARAMETER (SCRIPT=4) C Fill-area style: INTEGER SOLID, HOLLOW PARAMETER (SOLID=1) PARAMETER (HOLLOW=2) C----------------------------------------------------------------------- C CALL PGPAGE CALL PGBBUF CALL PGSAVE C C Define the Viewport C CALL PGSVP(0.1,0.6,0.1,0.6) C C Define the Window C CALL PGSWIN(0.0, 630.0, -2.0, 2.0) C C Draw a box C CALL PGSCI(CYAN) CALL PGBOX ('ABCTS', 90.0, 3, 'ABCTSV', 0.0, 0) C C Draw labels C CALL PGSCI (RED) CALL PGBOX ('N',90.0, 3, 'VN', 0.0, 0) C C Draw SIN line C DO 10 I=1,360 XR(I) = 2.0*I YR(I) = SIN(XR(I)/57.29577951) 10 CONTINUE CALL PGSCI (MAGENT) CALL PGSLS (DASHED) CALL PGLINE (360,XR,YR) C C Draw COS line by redefining the window C CALL PGSWIN (90.0, 720.0, -2.0, 2.0) CALL PGSCI (YELLOW) CALL PGSLS (DOTTED) CALL PGLINE (360,XR,YR) CALL PGSLS (FULL) C C Re-Define the Viewport C CALL PGSVP(0.45,0.85,0.45,0.85) C C Define the Window, and erase it C CALL PGSWIN(0.0, 180.0, -2.0, 2.0) CALL PGSCI(0) CALL PGRECT(0.0, 180., -2.0, 2.0) C C Draw a box C CALL PGSCI(BLUE) CALL PGBOX ('ABCTSM', 60.0, 3, 'VABCTSM', 1.0, 2) C C Draw SIN line C CALL PGSCI (WHITE) CALL PGSLS (DASHED) CALL PGLINE (360,XR,YR) C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX9 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates curve drawing with PGFUNT; the parametric curve drawn is C a simple Lissajous figure. C T. J. Pearson 1983 Oct 5 C---------------------------------------------------------------------- REAL PI, TWOPI PARAMETER (PI=3.14159265359) PARAMETER (TWOPI=2.0*PI) REAL FX, FY EXTERNAL FX, FY C C Call PGFUNT to draw the function (autoscaling). C CALL PGBBUF CALL PGSAVE CALL PGSCI(5) CALL PGFUNT(FX,FY,360,0.0,TWOPI,0) C C Call PGLAB to label the graph in a different color. C CALL PGSCI(3) CALL PGLAB('x','y','PGPLOT Example 9: routine PGFUNT') CALL PGUNSA CALL PGEBUF C END REAL FUNCTION FX(T) REAL T FX = SIN(T*5.0) RETURN END REAL FUNCTION FY(T) REAL T FY = SIN(T*4.0) RETURN END SUBROUTINE PGEX10 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates curve drawing with PGFUNX. C T. J. Pearson 1983 Oct 5 C---------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) C The following define mnemonic names for the color indices and C linestyle codes. INTEGER BLACK, WHITE, RED, GREEN, BLUE, CYAN, MAGENT, YELLOW PARAMETER (BLACK=0) PARAMETER (WHITE=1) PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (BLUE=4) PARAMETER (CYAN=5) PARAMETER (MAGENT=6) PARAMETER (YELLOW=7) INTEGER FULL, DASH, DOTD PARAMETER (FULL=1) PARAMETER (DASH=2) PARAMETER (DOTD=3) C C The Fortran functions to be plotted must be declared EXTERNAL. C REAL PGBSJ0, PGBSJ1 EXTERNAL PGBSJ0, PGBSJ1 C C Call PGFUNX twice to draw two functions (autoscaling the first time). C CALL PGBBUF CALL PGSAVE CALL PGSCI(YELLOW) CALL PGFUNX(PGBSJ0,500,0.0,10.0*PI,0) CALL PGSCI(RED) CALL PGSLS(DASH) CALL PGFUNX(PGBSJ1,500,0.0,10.0*PI,1) C C Call PGLAB to label the graph in a different color. Note the C use of "\f" to change font. Use PGMTXT to write an additional C legend inside the viewport. C CALL PGSCI(GREEN) CALL PGSLS(FULL) CALL PGLAB('\fix', '\fiy', 2 '\frPGPLOT Example 10: routine PGFUNX') CALL PGMTXT('T', -4.0, 0.5, 0.5, 1 '\frBessel Functions') C C Call PGARRO to label the curves. C CALL PGARRO(8.0, 0.7, 1.0, PGBSJ0(1.0)) CALL PGARRO(12.0, 0.5, 9.0, PGBSJ1(9.0)) CALL PGSTBG(GREEN) CALL PGSCI(0) CALL PGPTXT(8.0, 0.7, 0.0, 0.0, ' \fiy = J\d0\u(x)') CALL PGPTXT(12.0, 0.5, 0.0, 0.0, ' \fiy = J\d1\u(x)') CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX11 C----------------------------------------------------------------------- C Test routine for PGPLOT: draws a skeletal dodecahedron. C----------------------------------------------------------------------- INTEGER NVERT REAL T, T1, T2, T3 PARAMETER (NVERT=20) PARAMETER (T=1.618) PARAMETER (T1=1.0+T) PARAMETER (T2=-1.0*T) PARAMETER (T3=-1.0*T1) INTEGER I, J, K REAL VERT(3,NVERT), R, ZZ REAL X(2),Y(2) C C Cartesian coordinates of the 20 vertices. C DATA VERT/ T, T, T, T, T,T2, 3 T,T2, T, T,T2,T2, 5 T2, T, T, T2, T,T2, 7 T2,T2, T, T2,T2,T2, 9 T1,1.0,0.0, T1,-1.0,0.0, B T3,1.0,0.0, T3,-1.0,0.0, D 0.0,T1,1.0, 0.0,T1,-1.0, F 0.0,T3,1.0, 0.0,T3,-1.0, H 1.0,0.0,T1, -1.0,0.0,T1, J 1.0,0.0,T3, -1.0,0.0,T3 / C C Initialize the plot (no labels). C CALL PGBBUF CALL PGSAVE CALL PGENV(-4.,4.,-4.,4.,1,-2) CALL PGSCI(2) CALL PGSLS(1) CALL PGSLW(1) C C Write a heading. C CALL PGLAB(' ',' ','PGPLOT Example 11: Dodecahedron') C C Mark the vertices. C DO 2 I=1,NVERT ZZ = VERT(3,I) CALL PGPT1(VERT(1,I)+0.2*ZZ,VERT(2,I)+0.3*ZZ,9) 2 CONTINUE C C Draw the edges - test all vertex pairs to find the edges of the C correct length. C CALL PGSLW(3) DO 20 I=2,NVERT DO 10 J=1,I-1 R = 0. DO 5 K=1,3 R = R + (VERT(K,I)-VERT(K,J))**2 5 CONTINUE R = SQRT(R) IF(ABS(R-2.0).GT.0.1) GOTO 10 ZZ = VERT(3,I) X(1) = VERT(1,I)+0.2*ZZ Y(1) = VERT(2,I)+0.3*ZZ ZZ = VERT(3,J) X(2) = VERT(1,J)+0.2*ZZ Y(2) = VERT(2,J)+0.3*ZZ CALL PGLINE(2,X,Y) 10 CONTINUE 20 CONTINUE CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX12 C----------------------------------------------------------------------- C Test routine for PGPLOT: draw arrows with PGARRO. C----------------------------------------------------------------------- INTEGER NV, I, K REAL A, D, X, Y, XT, YT C C Number of arrows. C NV =16 C C Select a square viewport. C CALL PGBBUF CALL PGSAVE CALL PGSCH(0.7) CALL PGSCI(2) CALL PGENV(-1.05,1.05,-1.05,1.05,1,-1) CALL PGLAB(' ', ' ', 'PGPLOT Example 12: PGARRO') CALL PGSCI(1) C C Draw the arrows C K = 1 D = 360.0/57.29577951/NV A = -D DO 20 I=1,NV A = A+D X = COS(A) Y = SIN(A) XT = 0.2*COS(A-D) YT = 0.2*SIN(A-D) CALL PGSAH(K, 80.0-3.0*I, 0.5*REAL(I)/REAL(NV)) CALL PGSCH(0.25*I) CALL PGARRO(XT, YT, X, Y) K = K+1 IF (K.GT.2) K=1 20 CONTINUE C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX13 C---------------------------------------------------------------------- C This example illustrates the use of PGTBOX. C---------------------------------------------------------------------- INTEGER N PARAMETER (N=10) INTEGER I REAL X1(N), X2(N) CHARACTER*20 XOPT(N), BSL*1 DATA X1 / 4*0.0, -8000.0, 100.3, 205.3, -45000.0, 2*0.0/ DATA X2 /4*8000.0, 8000.0, 101.3, 201.1, 3*-100000.0/ DATA XOPT / 'BSTN', 'BSTNZ', 'BSTNZH', 'BSTNZD', 'BSNTZHFO', : 'BSTNZD', 'BSTNZHI', 'BSTNZHP', 'BSTNZDY', 'BSNTZHFOY'/ C BSL = CHAR(92) CALL PGPAGE CALL PGSAVE CALL PGBBUF CALL PGSCH(0.7) DO 100 I=1,N CALL PGSVP(0.15, 0.85, (0.7+REAL(N-I))/REAL(N), : (0.7+REAL(N-I+1))/REAL(N)) CALL PGSWIN(X1(I), X2(I), 0.0, 1.0) CALL PGTBOX(XOPT(I),0.0,0,' ',0.0,0) CALL PGLAB('Option = '//XOPT(I), ' ', ' ') IF (I.EQ.1) THEN CALL PGMTXT('B', -1.0, 0.5, 0.5, : BSL//'fiAxes drawn with PGTBOX') END IF 100 CONTINUE CALL PGEBUF CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX14 C----------------------------------------------------------------------- C Test routine for PGPLOT: polygon fill and color representation. C----------------------------------------------------------------------- INTEGER I, J, N, M 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 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----------------------------------------------------------------------- END SUBROUTINE PGEX15 C---------------------------------------------------------------------- C This is a line-drawing test; it draws a regular n-gon joining C each vertex to every other vertex. It is not optimized for pen C plotters. C---------------------------------------------------------------------- INTEGER I, J, NV REAL A, D, X(100), Y(100) C C Set the number of vertices, and compute the C coordinates for unit circumradius. C NV = 17 D = 360.0/NV A = -D DO 20 I=1,NV A = A+D X(I) = COS(A/57.29577951) Y(I) = SIN(A/57.29577951) 20 CONTINUE C C Select a square viewport. C CALL PGBBUF CALL PGSAVE CALL PGSCH(0.5) CALL PGSCI(2) CALL PGENV(-1.05,1.05,-1.05,1.05,1,-1) CALL PGLAB(' ', ' ', 'PGPLOT Example 15: PGMOVE and PGDRAW') CALL PGSCR(0,0.2,0.3,0.3) CALL PGSCR(1,1.0,0.5,0.2) CALL PGSCR(2,0.2,0.5,1.0) CALL PGSCI(1) C C Draw the polygon. C DO 40 I=1,NV-1 DO 30 J=I+1,NV CALL PGMOVE(X(I),Y(I)) CALL PGDRAW(X(J),Y(J)) 30 CONTINUE 40 CONTINUE C C Flush the buffer. C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END REAL FUNCTION PGBSJ0(XX) REAL XX C----------------------------------------------------------------------- C Bessel function of order 0 (approximate). C Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. C----------------------------------------------------------------------- REAL X, XO3, T, F0, THETA0 C X = ABS(XX) IF (X .LE. 3.0) THEN XO3 = X/3.0 T = XO3*XO3 PGBSJ0 = 1.0 + T*(-2.2499997 + 1 T*( 1.2656208 + 2 T*(-0.3163866 + 3 T*( 0.0444479 + 4 T*(-0.0039444 + 5 T*( 0.0002100)))))) ELSE T = 3.0/X F0 = 0.79788456 + 1 T*(-0.00000077 + 2 T*(-0.00552740 + 3 T*(-0.00009512 + 4 T*( 0.00137237 + 5 T*(-0.00072805 + 6 T*( 0.00014476)))))) THETA0 = X - 0.78539816 + 1 T*(-0.04166397 + 2 T*(-0.00003954 + 3 T*( 0.00262573 + 4 T*(-0.00054125 + 5 T*(-0.00029333 + 6 T*( 0.00013558)))))) PGBSJ0 = F0*COS(THETA0)/SQRT(X) END IF C----------------------------------------------------------------------- END REAL FUNCTION PGBSJ1(XX) REAL XX C----------------------------------------------------------------------- C Bessel function of order 1 (approximate). C Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. C----------------------------------------------------------------------- REAL X, XO3, T, F1, THETA1 C X = ABS(XX) IF (X .LE. 3.0) THEN XO3 = X/3.0 T = XO3*XO3 PGBSJ1 = 0.5 + T*(-0.56249985 + 1 T*( 0.21093573 + 2 T*(-0.03954289 + 3 T*( 0.00443319 + 4 T*(-0.00031761 + 5 T*( 0.00001109)))))) PGBSJ1 = PGBSJ1*XX ELSE T = 3.0/X F1 = 0.79788456 + 1 T*( 0.00000156 + 2 T*( 0.01659667 + 3 T*( 0.00017105 + 4 T*(-0.00249511 + 5 T*( 0.00113653 + 6 T*(-0.00020033)))))) THETA1 = X -2.35619449 + 1 T*( 0.12499612 + 2 T*( 0.00005650 + 3 T*(-0.00637879 + 4 T*( 0.00074348 + 5 T*( 0.00079824 + 6 T*(-0.00029166)))))) PGBSJ1 = F1*COS(THETA1)/SQRT(X) END IF IF (XX .LT. 0.0) PGBSJ1 = -PGBSJ1 C----------------------------------------------------------------------- END REAL FUNCTION PGRNRM (ISEED) INTEGER ISEED C----------------------------------------------------------------------- C Returns a normally distributed deviate with zero mean and unit C variance. The routine uses the Box-Muller transformation of uniform C deviates. For a more efficient implementation of this algorithm, C see Press et al., Numerical Recipes, Sec. 7.2. C C Arguments: C ISEED (in/out) : seed used for PGRAND random-number generator. C C Subroutines required: C PGRAND -- return a uniform random deviate between 0 and 1. C C History: C 1995 Dec 12 - TJP. C----------------------------------------------------------------------- REAL R, X, Y, PGRAND C 10 X = 2.0*PGRAND(ISEED) - 1.0 Y = 2.0*PGRAND(ISEED) - 1.0 R = X**2 + Y**2 IF (R.GE.1.0) GOTO 10 PGRNRM = X*SQRT(-2.0*LOG(R)/R) C----------------------------------------------------------------------- END REAL FUNCTION PGRAND(ISEED) INTEGER ISEED C----------------------------------------------------------------------- C Returns a uniform random deviate between 0.0 and 1.0. C C NOTE: this is not a good random-number generator; it is only C intended for exercising the PGPLOT routines. C C Based on: Park and Miller's "Minimal Standard" random number C generator (Comm. ACM, 31, 1192, 1988) C C Arguments: C ISEED (in/out) : seed. C----------------------------------------------------------------------- INTEGER IM, IA, IQ, IR PARAMETER (IM=2147483647) PARAMETER (IA=16807, IQ=127773, IR= 2836) REAL AM PARAMETER (AM=128.0/IM) INTEGER K C- K = ISEED/IQ ISEED = IA*(ISEED-K*IQ) - IR*K IF (ISEED.LT.0) ISEED = ISEED+IM PGRAND = AM*(ISEED/128) RETURN END CALL Ppgplot/examples/pgdemo13.f010064400040640000322000001004050634733261500161470ustar00tjpcitmbr00000400000017 PROGRAM PGDE13 C----------------------------------------------------------------------- C Demonstration program for PGPLOT with multiple devices. C It requires an interactive device which presents a menu of graphs C to be displayed on the second device, which may be interactive or C hardcopy. C----------------------------------------------------------------------- INTEGER PGOPEN, ID, ID1, ID2, NP C C Call PGOPEN to initiate PGPLOT and open the output device; PGBEG C will prompt the user to supply the device name and type. Always C check the return code from PGBEG. WRITE (*,*) 'This program demonstrates the use of two devices' WRITE (*,*) 'in PGPLOT. An interactive device is used to' WRITE (*,*) 'present a menu of graphs that may be displayed on' WRITE (*,*) 'a second device. Use the cursor or mouse to select' WRITE (*,*) 'the graph to be displayed. It is also possible' WRITE (*,*) 'to display either 1 graph per page or 4 graphs' WRITE (*,*) 'per page.' WRITE (*,*) 'If you have an X-Window display, try specifying' WRITE (*,*) '/XWIN for both devices.' WRITE (*,*) C ID1 = PGOPEN('?Graphics device for menu (eg, /XWIN): ') IF (ID1.LE.0) STOP CALL INIT CALL PGASK(.FALSE.) ID2 = PGOPEN('?Graphics device for graphs (eg, file/PS): ') IF (ID2.LE.0) STOP CALL PGASK(.FALSE.) C C Select a plot. C NP = 1 100 CALL PGSLCT(ID1) CALL MENU(NP, ID) CALL PGSLCT(ID2) CALL PGSAVE CALL PGBBUF IF (ID.EQ.1) THEN CALL PGEX1 ELSE IF (ID.EQ.2) THEN CALL PGEX2 ELSE IF (ID.EQ.3) THEN CALL PGEX3 ELSE IF (ID.EQ.4) THEN CALL PGEX4 ELSE IF (ID.EQ.5) THEN CALL PGEX5 ELSE IF (ID.EQ.6) THEN CALL PGEX6 ELSE IF (ID.EQ.7) THEN CALL PGEX7 ELSE IF (ID.EQ.8) THEN CALL PGEX8 ELSE IF (ID.EQ.9) THEN CALL PGEX9 ELSE IF (ID.EQ.10) THEN CALL PGEX10 ELSE IF (ID.EQ.11) THEN CALL PGEX11 ELSE IF (ID.EQ.12) THEN CALL PGEX12 ELSE IF (ID.EQ.13) THEN CALL PGEX13 ELSE IF (ID.EQ.14) THEN CALL PGSUBP(1,1) NP = 1 ELSE IF (ID.EQ.15) THEN CALL PGSUBP(2,2) NP = 4 ELSE GOTO 200 END IF CALL PGEBUF CALL PGUNSA GOTO 100 C C Done: close devices. C 200 CALL PGEND C----------------------------------------------------------------------- END SUBROUTINE INIT C C Set up graphics device to display menu. C----------------------------------------------------------------------- CALL PGPAP(2.5, 2.0) CALL PGPAGE CALL PGSVP(0.0,1.0,0.0,1.0) CALL PGSWIN(0.0,0.5,0.0,1.0) CALL PGSCR(0, 0.4, 0.4, 0.4) RETURN C----------------------------------------------------------------------- END SUBROUTINE MENU(NP, ID) INTEGER NP, ID C C Display menu of plots. C----------------------------------------------------------------------- INTEGER NBOX PARAMETER (NBOX=16) CHARACTER*12 VALUE(NBOX) INTEGER I, JUNK, K REAL X1, X2, Y(NBOX), XX, YY, R CHARACTER CH INTEGER PGCURS C DATA VALUE / '1', '2', '3', '4', '5', '6', '7', '8', '9', : '10', '11', '12', '13', : 'One panel', 'Four panels', 'EXIT' / DATA XX/0.5/, YY/0.5/ C X1 = 0.1 X2 = 0.2 DO 5 I=1,NBOX Y(I) = 1.0 - REAL(I+1)/REAL(NBOX+2) 5 CONTINUE C C Display buttons. C CALL PGBBUF CALL PGSAVE CALL PGERAS CALL PGSCI(1) CALL PGSCH(2.5) CALL PGPTXT(X1, 1.0-1.0/REAL(NBOX+2), 0.0, 0.0, '\fiMENU') CALL PGSLW(1) CALL PGSCH(2.0) DO 10 I=1,NBOX CALL PGSCI(1) CALL PGSFS(1) CALL PGCIRC(X1, Y(I), 0.02) CALL PGSCI(2) CALL PGSFS(2) CALL PGCIRC(X1, Y(I), 0.02) CALL PGSCI(1) CALL PGPTXT(X2, Y(I), 0.0, 0.0, VALUE(I)) 10 CONTINUE K = 14 IF (NP.EQ.4) K = 15 CALL PGSCI(2) CALL PGSFS(1) CALL PGCIRC(X1, Y(K), 0.02) CALL PGUNSA CALL PGEBUF C C Cursor input. C 20 JUNK = PGCURS(XX, YY, CH) IF (ICHAR(CH).EQ.0) GOTO 50 C C Find which box and highlight it C DO 30 I=1,NBOX R = (XX-X1)**2 +(YY-Y(I))**2 IF (R.LT.(0.03**2)) THEN ID = I CALL PGSAVE CALL PGSCI(2) CALL PGSFS(1) CALL PGCIRC(X1, Y(I), 0.02) CALL PGUNSA RETURN END IF 30 CONTINUE GOTO 20 50 ID = 0 RETURN END SUBROUTINE PGEX1 C----------------------------------------------------------------------- C This example illustrates the use of PGENV, PGLAB, PGPT, PGLINE. C----------------------------------------------------------------------- INTEGER I REAL XS(5),YS(5), XR(100), YR(100) DATA XS/1.,2.,3.,4.,5./ DATA YS/1.,4.,9.,16.,25./ C C Call PGENV to specify the range of the axes and to draw a box, and C PGLAB to label it. The x-axis runs from 0 to 10, and y from 0 to 20. C CALL PGENV(0.,10.,0.,20.,0,1) CALL PGLAB('(x)', '(y)', 'PGPLOT Example 1: y = x\u2') C C Mark five points (coordinates in arrays XS and YS), using symbol C number 9. C CALL PGPT(5,XS,YS,9) C C Compute the function at 60 points, and use PGLINE to draw it. C DO 10 I=1,60 XR(I) = 0.1*I YR(I) = XR(I)**2 10 CONTINUE CALL PGLINE(60,XR,YR) C----------------------------------------------------------------------- END SUBROUTINE PGEX2 C----------------------------------------------------------------------- C Repeat the process for another graph. This one is a graph of the C sinc (sin x over x) function. C----------------------------------------------------------------------- INTEGER I REAL XR(100), YR(100) C CALL PGENV(-2.,10.,-0.4,1.2,0,1) CALL PGLAB('(x)', 'sin(x)/x', $ 'PGPLOT Example 2: Sinc Function') DO 20 I=1,100 XR(I) = (I-20)/6. YR(I) = 1.0 IF (XR(I).NE.0.0) YR(I) = SIN(XR(I))/XR(I) 20 CONTINUE CALL PGLINE(100,XR,YR) C----------------------------------------------------------------------- END SUBROUTINE PGEX3 C---------------------------------------------------------------------- C This example illustrates the use of PGBOX and attribute routines to C mix colors and line-styles. C---------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) INTEGER I REAL XR(360), YR(360) REAL ARG C C Call PGENV to initialize the viewport and window; the C AXIS argument is -2, so no frame or labels will be drawn. C CALL PGENV(0.,720.,-2.0,2.0,0,-2) CALL PGSAVE C C Set the color index for the axes and grid (index 5 = cyan). C Call PGBOX to draw first a grid at low brightness, and then a C frame and axes at full brightness. Note that as the x-axis is C to represent an angle in degrees, we request an explicit tick C interval of 90 deg with subdivisions at 30 deg, as multiples of C 3 are a more natural division than the default. C CALL PGSCI(14) CALL PGBOX('G',30.0,0,'G',0.2,0) CALL PGSCI(5) CALL PGBOX('ABCTSN',90.0,3,'ABCTSNV',0.0,0) C C Call PGLAB to label the graph in a different color (3=green). C CALL PGSCI(3) CALL PGLAB('x (degrees)','f(x)','PGPLOT Example 3') C C Compute the function to be plotted: a trig function of an C angle in degrees, computed every 2 degrees. C DO 20 I=1,360 XR(I) = 2.0*I ARG = XR(I)/180.0*PI YR(I) = SIN(ARG) + 0.5*COS(2.0*ARG) + 1 0.5*SIN(1.5*ARG+PI/3.0) 20 CONTINUE C C Change the color (6=magenta), line-style (2=dashed), and line C width and draw the function. C CALL PGSCI(6) CALL PGSLS(2) CALL PGSLW(3) CALL PGLINE(360,XR,YR) C C Restore attributes to defaults. C CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX4 C----------------------------------------------------------------------- C Demonstration program for PGPLOT: draw histograms. C----------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) INTEGER I, ISEED REAL DATA(1000), X(620), Y(620) REAL PGRNRM C C Call PGRNRM to obtain 1000 samples from a normal distribution. C ISEED = -5678921 DO 10 I=1,1000 DATA(I) = PGRNRM(ISEED) 10 CONTINUE C C Draw a histogram of these values. C CALL PGSAVE CALL PGHIST(1000,DATA,-3.1,3.1,31,0) C C Samples from another normal distribution. C DO 15 I=1,200 DATA(I) = 1.0+0.5*PGRNRM(ISEED) 15 CONTINUE C C Draw another histogram (filled) on same axes. C CALL PGSCI(15) CALL PGHIST(200,DATA,-3.1,3.1,31,3) CALL PGSCI(0) CALL PGHIST(200,DATA,-3.1,3.1,31,1) CALL PGSCI(1) C C Redraw the box which may have been clobbered by the histogram. C CALL PGBOX('BST', 0.0, 0, ' ', 0.0, 0) C C Label the plot. C CALL PGLAB('Variate', ' ', $ 'PGPLOT Example 4: Histograms (Gaussian)') C C Superimpose the theoretical distribution. C DO 20 I=1,620 X(I) = -3.1 + 0.01*(I-1) Y(I) = 0.2*1000./SQRT(2.0*PI)*EXP(-0.5*X(I)*X(I)) 20 CONTINUE CALL PGLINE(620,X,Y) CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX5 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates how to draw a log-log plot. C PGPLOT subroutines demonstrated: C PGENV, PGERRY, PGLAB, PGLINE, PGPT, PGSCI. C---------------------------------------------------------------------- INTEGER RED, GREEN, CYAN PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (CYAN=5) INTEGER NP PARAMETER (NP=15) INTEGER I REAL X, YLO(NP), YHI(NP) REAL FREQ(NP), FLUX(NP), XP(100), YP(100), ERR(NP) DATA FREQ / 26., 38., 80., 160., 178., 318., 1 365., 408., 750., 1400., 2695., 2700., 2 5000., 10695., 14900. / DATA FLUX / 38.0, 66.4, 89.0, 69.8, 55.9, 37.4, 1 46.8, 42.4, 27.0, 15.8, 9.09, 9.17, 2 5.35, 2.56, 1.73 / DATA ERR / 6.0, 6.0, 13.0, 9.1, 2.9, 1.4, 1 2.7, 3.0, 0.34, 0.8, 0.2, 0.46, 2 0.15, 0.08, 0.01 / C C Call PGENV to initialize the viewport and window; the AXIS argument C is 30 so both axes will be logarithmic. The X-axis (frequency) runs C from 0.01 to 100 GHz, the Y-axis (flux density) runs from 0.3 to 300 C Jy. Note that it is necessary to specify the logarithms of these C quantities in the call to PGENV. We request equal scales in x and y C so that slopes will be correct. Use PGLAB to label the graph. C CALL PGSAVE CALL PGSCI(CYAN) CALL PGENV(-2.0,2.0,-0.5,2.5,1,30) CALL PGLAB('Frequency, \gn (GHz)', 1 'Flux Density, S\d\gn\u (Jy)', 2 'PGPLOT Example 5: Log-Log plot') C C Draw a fit to the spectrum (don't ask how this was chosen). This C curve is drawn before the data points, so that the data will write C over the curve, rather than vice versa. C DO 10 I=1,100 X = 1.3 + I*0.03 XP(I) = X-3.0 YP(I) = 5.18 - 1.15*X -7.72*EXP(-X) 10 CONTINUE CALL PGSCI(RED) CALL PGLINE(100,XP,YP) C C Plot the measured flux densities: here the data are installed with a C DATA statement; in a more general program, they might be read from a C file. We first have to take logarithms (the -3.0 converts MHz to GHz). C DO 20 I=1,NP XP(I) = ALOG10(FREQ(I))-3.0 YP(I) = ALOG10(FLUX(I)) 20 CONTINUE CALL PGSCI(GREEN) CALL PGPT(NP, XP, YP, 17) C C Draw +/- 2 sigma error bars: take logs of both limits. C DO 30 I=1,NP YHI(I) = ALOG10(FLUX(I)+2.*ERR(I)) YLO(I) = ALOG10(FLUX(I)-2.*ERR(I)) 30 CONTINUE CALL PGERRY(NP,XP,YLO,YHI,1.0) CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX6 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 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 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----------------------------------------------------------------------- END SUBROUTINE PGEX7 C----------------------------------------------------------------------- C A plot with a large number of symbols; plus test of PGERR1. C----------------------------------------------------------------------- INTEGER I, ISEED REAL XS(300),YS(300), XR(101), YR(101), XP, YP, XSIG, YSIG REAL PGRAND, PGRNRM C C Window and axes. C CALL PGBBUF CALL PGSAVE CALL PGSCI(1) CALL PGENV(0.,5.,-0.3,0.6,0,1) CALL PGLAB('\fix', '\fiy', 'PGPLOT Example 7: scatter plot') C C Random data points. C ISEED = -45678921 DO 10 I=1,300 XS(I) = 5.0*PGRAND(ISEED) YS(I) = XS(I)*EXP(-XS(I)) + 0.05*PGRNRM(ISEED) 10 CONTINUE CALL PGSCI(3) CALL PGPT(100,XS,YS,3) CALL PGPT(100,XS(101),YS(101),17) CALL PGPT(100,XS(201),YS(201),21) C C Curve defining parent distribution. C DO 20 I=1,101 XR(I) = 0.05*(I-1) YR(I) = XR(I)*EXP(-XR(I)) 20 CONTINUE CALL PGSCI(2) CALL PGLINE(101,XR,YR) C C Test of PGERR1/PGPT1. C XP = XS(101) YP = YS(101) XSIG = 0.2 YSIG = 0.1 CALL PGSCI(5) CALL PGSCH(3.0) CALL PGERR1(5, XP, YP, XSIG, 1.0) CALL PGERR1(6, XP, YP, YSIG, 1.0) CALL PGPT1(XP,YP,21) C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX8 C----------------------------------------------------------------------- C Demonstration program for PGPLOT. This program shows some of the C possibilities for overlapping windows and viewports. C T. J. Pearson 1986 Nov 28 C----------------------------------------------------------------------- INTEGER I REAL XR(720), YR(720) C----------------------------------------------------------------------- C Color index: INTEGER BLACK, WHITE, RED, GREEN, BLUE, CYAN, MAGENT, YELLOW PARAMETER (BLACK=0) PARAMETER (WHITE=1) PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (BLUE=4) PARAMETER (CYAN=5) PARAMETER (MAGENT=6) PARAMETER (YELLOW=7) C Line style: INTEGER FULL, DASHED, DOTDSH, DOTTED, FANCY PARAMETER (FULL=1) PARAMETER (DASHED=2) PARAMETER (DOTDSH=3) PARAMETER (DOTTED=4) PARAMETER (FANCY=5) C Character font: INTEGER NORMAL, ROMAN, ITALIC, SCRIPT PARAMETER (NORMAL=1) PARAMETER (ROMAN=2) PARAMETER (ITALIC=3) PARAMETER (SCRIPT=4) C Fill-area style: INTEGER SOLID, HOLLOW PARAMETER (SOLID=1) PARAMETER (HOLLOW=2) C----------------------------------------------------------------------- C CALL PGPAGE CALL PGBBUF CALL PGSAVE C C Define the Viewport C CALL PGSVP(0.1,0.6,0.1,0.6) C C Define the Window C CALL PGSWIN(0.0, 630.0, -2.0, 2.0) C C Draw a box C CALL PGSCI(CYAN) CALL PGBOX ('ABCTS', 90.0, 3, 'ABCTSV', 0.0, 0) C C Draw labels C CALL PGSCI (RED) CALL PGBOX ('N',90.0, 3, 'VN', 0.0, 0) C C Draw SIN line C DO 10 I=1,360 XR(I) = 2.0*I YR(I) = SIN(XR(I)/57.29577951) 10 CONTINUE CALL PGSCI (MAGENT) CALL PGSLS (DASHED) CALL PGLINE (360,XR,YR) C C Draw COS line by redefining the window C CALL PGSWIN (90.0, 720.0, -2.0, 2.0) CALL PGSCI (YELLOW) CALL PGSLS (DOTTED) CALL PGLINE (360,XR,YR) CALL PGSLS (FULL) C C Re-Define the Viewport C CALL PGSVP(0.45,0.85,0.45,0.85) C C Define the Window, and erase it C CALL PGSWIN(0.0, 180.0, -2.0, 2.0) CALL PGSCI(0) CALL PGRECT(0.0, 180., -2.0, 2.0) C C Draw a box C CALL PGSCI(BLUE) CALL PGBOX ('ABCTSM', 60.0, 3, 'VABCTSM', 1.0, 2) C C Draw SIN line C CALL PGSCI (WHITE) CALL PGSLS (DASHED) CALL PGLINE (360,XR,YR) C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX9 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates curve drawing with PGFUNT; the parametric curve drawn is C a simple Lissajous figure. C T. J. Pearson 1983 Oct 5 C---------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) REAL FX, FY EXTERNAL FX, FY C C Call PGFUNT to draw the function (autoscaling). C CALL PGBBUF CALL PGSAVE CALL PGSCI(5) CALL PGFUNT(FX,FY,360,0.0,2.0*PI,0) C C Call PGLAB to label the graph in a different color. C CALL PGSCI(3) CALL PGLAB('x','y','PGPLOT Example 9: routine PGFUNT') CALL PGUNSA CALL PGEBUF C END REAL FUNCTION FX(T) REAL T FX = SIN(T*5.0) RETURN END REAL FUNCTION FY(T) REAL T FY = SIN(T*4.0) RETURN END SUBROUTINE PGEX10 C---------------------------------------------------------------------- C Demonstration program for the PGPLOT plotting package. This example C illustrates curve drawing with PGFUNX. C T. J. Pearson 1983 Oct 5 C---------------------------------------------------------------------- REAL PI PARAMETER (PI=3.14159265359) C The following define mnemonic names for the color indices and C linestyle codes. INTEGER BLACK, WHITE, RED, GREEN, BLUE, CYAN, MAGENT, YELLOW PARAMETER (BLACK=0) PARAMETER (WHITE=1) PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (BLUE=4) PARAMETER (CYAN=5) PARAMETER (MAGENT=6) PARAMETER (YELLOW=7) INTEGER FULL, DASH, DOTD PARAMETER (FULL=1) PARAMETER (DASH=2) PARAMETER (DOTD=3) C C The Fortran functions to be plotted must be declared EXTERNAL. C REAL PGBSJ0, PGBSJ1 EXTERNAL PGBSJ0, PGBSJ1 C C Call PGFUNX twice to draw two functions (autoscaling the first time). C CALL PGBBUF CALL PGSAVE CALL PGSCI(YELLOW) CALL PGFUNX(PGBSJ0,500,0.0,10.0*PI,0) CALL PGSCI(RED) CALL PGSLS(DASH) CALL PGFUNX(PGBSJ1,500,0.0,10.0*PI,1) C C Call PGLAB to label the graph in a different color. Note the C use of "\f" to change font. Use PGMTXT to write an additional C legend inside the viewport. C CALL PGSCI(GREEN) CALL PGSLS(FULL) CALL PGLAB('\fix', '\fiy', 2 '\frPGPLOT Example 10: routine PGFUNX') CALL PGMTXT('T', -4.0, 0.5, 0.5, 1 '\frBessel Functions') C C Call PGARRO to label the curves. C CALL PGARRO(8.0, 0.7, 1.0, PGBSJ0(1.0)) CALL PGARRO(12.0, 0.5, 9.0, PGBSJ1(9.0)) CALL PGSTBG(GREEN) CALL PGSCI(0) CALL PGPTXT(8.0, 0.7, 0.0, 0.0, ' \fiy = J\d0\u(x)') CALL PGPTXT(12.0, 0.5, 0.0, 0.0, ' \fiy = J\d1\u(x)') CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX11 C----------------------------------------------------------------------- C Test routine for PGPLOT: draws a skeletal dodecahedron. C----------------------------------------------------------------------- INTEGER NVERT REAL T, T1, T2, T3 PARAMETER (NVERT=20) PARAMETER (T=1.618) PARAMETER (T1=1.0+T) PARAMETER (T2=-1.0*T) PARAMETER (T3=-1.0*T1) INTEGER I, J, K REAL VERT(3,NVERT), R, ZZ REAL X(2),Y(2) C C Cartesian coordinates of the 20 vertices. C DATA VERT/ T, T, T, T, T,T2, 3 T,T2, T, T,T2,T2, 5 T2, T, T, T2, T,T2, 7 T2,T2, T, T2,T2,T2, 9 T1,1.0,0.0, T1,-1.0,0.0, B T3,1.0,0.0, T3,-1.0,0.0, D 0.0,T1,1.0, 0.0,T1,-1.0, F 0.0,T3,1.0, 0.0,T3,-1.0, H 1.0,0.0,T1, -1.0,0.0,T1, J 1.0,0.0,T3, -1.0,0.0,T3 / C C Initialize the plot (no labels). C CALL PGBBUF CALL PGSAVE CALL PGENV(-4.,4.,-4.,4.,1,-2) CALL PGSCI(2) CALL PGSLS(1) CALL PGSLW(1) C C Write a heading. C CALL PGLAB(' ',' ','PGPLOT Example 11: Dodecahedron') C C Mark the vertices. C DO 2 I=1,NVERT ZZ = VERT(3,I) CALL PGPT1(VERT(1,I)+0.2*ZZ,VERT(2,I)+0.3*ZZ,9) 2 CONTINUE C C Draw the edges - test all vertex pairs to find the edges of the C correct length. C CALL PGSLW(3) DO 20 I=2,NVERT DO 10 J=1,I-1 R = 0. DO 5 K=1,3 R = R + (VERT(K,I)-VERT(K,J))**2 5 CONTINUE R = SQRT(R) IF(ABS(R-2.0).GT.0.1) GOTO 10 ZZ = VERT(3,I) X(1) = VERT(1,I)+0.2*ZZ Y(1) = VERT(2,I)+0.3*ZZ ZZ = VERT(3,J) X(2) = VERT(1,J)+0.2*ZZ Y(2) = VERT(2,J)+0.3*ZZ CALL PGLINE(2,X,Y) 10 CONTINUE 20 CONTINUE CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX12 C----------------------------------------------------------------------- C Test routine for PGPLOT: draw arrows with PGARRO. C----------------------------------------------------------------------- INTEGER NV, I, K REAL A, D, X, Y, XT, YT C C Number of arrows. C NV =16 C C Select a square viewport. C CALL PGBBUF CALL PGSAVE CALL PGSCH(0.7) CALL PGSCI(2) CALL PGENV(-1.05,1.05,-1.05,1.05,1,-1) CALL PGLAB(' ', ' ', 'PGPLOT Example 12: PGARRO') CALL PGSCI(1) C C Draw the arrows C K = 1 D = 360.0/57.29577951/NV A = -D DO 20 I=1,NV A = A+D X = COS(A) Y = SIN(A) XT = 0.2*COS(A-D) YT = 0.2*SIN(A-D) CALL PGSAH(K, 80.0-3.0*I, 0.5*REAL(I)/REAL(NV)) CALL PGSCH(0.25*I) CALL PGARRO(XT, YT, X, Y) K = K+1 IF (K.GT.2) K=1 20 CONTINUE C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END SUBROUTINE PGEX13 C---------------------------------------------------------------------- C This example illustrates the use of PGTBOX. C---------------------------------------------------------------------- INTEGER N PARAMETER (N=10) INTEGER I REAL X1(N), X2(N) CHARACTER*20 XOPT(N), BSL*1 DATA X1 / 4*0.0, -8000.0, 100.3, 205.3, -45000.0, 2*0.0/ DATA X2 /4*8000.0, 8000.0, 101.3, 201.1, 3*-100000.0/ DATA XOPT / 'BSTN', 'BSTNZ', 'BSTNZH', 'BSTNZD', 'BSNTZHFO', : 'BSTNZD', 'BSTNZHI', 'BSTNZHP', 'BSTNZDY', 'BSNTZHFOY'/ C BSL = CHAR(92) CALL PGPAGE CALL PGSAVE CALL PGBBUF CALL PGSCH(0.7) DO 100 I=1,N CALL PGSVP(0.15, 0.85, (0.7+REAL(N-I))/REAL(N), : (0.7+REAL(N-I+1))/REAL(N)) CALL PGSWIN(X1(I), X2(I), 0.0, 1.0) CALL PGTBOX(XOPT(I),0.0,0,' ',0.0,0) CALL PGLAB('Option = '//XOPT(I), ' ', ' ') IF (I.EQ.1) THEN CALL PGMTXT('B', -1.0, 0.5, 0.5, : BSL//'fiAxes drawn with PGTBOX') END IF 100 CONTINUE CALL PGEBUF CALL PGUNSA C----------------------------------------------------------------------- END SUBROUTINE PGEX14 C----------------------------------------------------------------------- C Test routine for PGPLOT: polygon fill and color representation. C----------------------------------------------------------------------- INTEGER I, J, N, M 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 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----------------------------------------------------------------------- END SUBROUTINE PGEX15 C---------------------------------------------------------------------- C This is a line-drawing test; it draws a regular n-gon joining C each vertex to every other vertex. It is not optimized for pen C plotters. C---------------------------------------------------------------------- INTEGER I, J, NV REAL A, D, X(100), Y(100) C C Set the number of vertices, and compute the C coordinates for unit circumradius. C NV = 17 D = 360.0/NV A = -D DO 20 I=1,NV A = A+D X(I) = COS(A/57.29577951) Y(I) = SIN(A/57.29577951) 20 CONTINUE C C Select a square viewport. C CALL PGBBUF CALL PGSAVE CALL PGSCH(0.5) CALL PGSCI(2) CALL PGENV(-1.05,1.05,-1.05,1.05,1,-1) CALL PGLAB(' ', ' ', 'PGPLOT Example 15: PGMOVE and PGDRAW') CALL PGSCR(0,0.2,0.3,0.3) CALL PGSCR(1,1.0,0.5,0.2) CALL PGSCR(2,0.2,0.5,1.0) CALL PGSCI(1) C C Draw the polygon. C DO 40 I=1,NV-1 DO 30 J=I+1,NV CALL PGMOVE(X(I),Y(I)) CALL PGDRAW(X(J),Y(J)) 30 CONTINUE 40 CONTINUE C C Flush the buffer. C CALL PGUNSA CALL PGEBUF C----------------------------------------------------------------------- END REAL FUNCTION PGBSJ0(XX) REAL XX C----------------------------------------------------------------------- C Bessel function of order 0 (approximate). C Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. C----------------------------------------------------------------------- REAL X, XO3, T, F0, THETA0 C X = ABS(XX) IF (X .LE. 3.0) THEN XO3 = X/3.0 T = XO3*XO3 PGBSJ0 = 1.0 + T*(-2.2499997 + 1 T*( 1.2656208 + 2 T*(-0.3163866 + 3 T*( 0.0444479 + 4 T*(-0.0039444 + 5 T*( 0.0002100)))))) ELSE T = 3.0/X F0 = 0.79788456 + 1 T*(-0.00000077 + 2 T*(-0.00552740 + 3 T*(-0.00009512 + 4 T*( 0.00137237 + 5 T*(-0.00072805 + 6 T*( 0.00014476)))))) THETA0 = X - 0.78539816 + 1 T*(-0.04166397 + 2 T*(-0.00003954 + 3 T*( 0.00262573 + 4 T*(-0.00054125 + 5 T*(-0.00029333 + 6 T*( 0.00013558)))))) PGBSJ0 = F0*COS(THETA0)/SQRT(X) END IF C----------------------------------------------------------------------- END REAL FUNCTION PGBSJ1(XX) REAL XX C----------------------------------------------------------------------- C Bessel function of order 1 (approximate). C Reference: Abramowitz and Stegun: Handbook of Mathematical Functions. C----------------------------------------------------------------------- REAL X, XO3, T, F1, THETA1 C X = ABS(XX) IF (X .LE. 3.0) THEN XO3 = X/3.0 T = XO3*XO3 PGBSJ1 = 0.5 + T*(-0.56249985 + 1 T*( 0.21093573 + 2 T*(-0.03954289 + 3 T*( 0.00443319 + 4 T*(-0.00031761 + 5 T*( 0.00001109)))))) PGBSJ1 = PGBSJ1*XX ELSE T = 3.0/X F1 = 0.79788456 + 1 T*( 0.00000156 + 2 T*( 0.01659667 + 3 T*( 0.00017105 + 4 T*(-0.00249511 + 5 T*( 0.00113653 + 6 T*(-0.00020033)))))) THETA1 = X -2.35619449 + 1 T*( 0.12499612 + 2 T*( 0.00005650 + 3 T*(-0.00637879 + 4 T*( 0.00074348 + 5 T*( 0.00079824 + 6 T*(-0.00029166)))))) PGBSJ1 = F1*COS(THETA1)/SQRT(X) END IF IF (XX .LT. 0.0) PGBSJ1 = -PGBSJ1 C----------------------------------------------------------------------- END REAL FUNCTION PGRNRM (ISEED) INTEGER ISEED C----------------------------------------------------------------------- C Returns a normally distributed deviate with zero mean and unit C variance. The routine uses the Box-Muller transformation of uniform C deviates. For a more efficient implementation of this algorithm, C see Press et al., Numerical Recipes, Sec. 7.2. C C Arguments: C ISEED (in/out) : seed used for PGRAND random-number generator. C C Subroutines required: C PGRAND -- return a uniform random deviate between 0 and 1. C C History: C 1995 Dec 12 - TJP. C----------------------------------------------------------------------- REAL R, X, Y, PGRAND C 10 X = 2.0*PGRAND(ISEED) - 1.0 Y = 2.0*PGRAND(ISEED) - 1.0 R = X**2 + Y**2 IF (R.GE.1.0) GOTO 10 PGRNRM = X*SQRT(-2.0*LOG(R)/R) C----------------------------------------------------------------------- END REAL FUNCTION PGRAND(ISEED) INTEGER ISEED C----------------------------------------------------------------------- C Returns a uniform random deviate between 0.0 and 1.0. C C NOTE: this is not a good random-number generator; it is only C intended for exercising the PGPLOT routines. C C Based on: Park and Miller's "Minimal Standard" random number C generator (Comm. ACM, 31, 1192, 1988) C C Arguments: C ISEED (in/out) : seed. C----------------------------------------------------------------------- INTEGER IM, IA, IQ, IR PARAMETER (IM=2147483647) PARAMETER (IA=16807, IQ=127773, IR= 2836) REAL AM PARAMETER (AM=128.0/IM) INTEGER K C- K = ISEED/IQ ISEED = IA*(ISEED-K*IQ) - IR*K IF (ISEED.LT.0) ISEED = ISEED+IM PGRAND = AM*(ISEED/128) RETURN END CALL PGSLW(3) DO 20 I=2,NVERT DO 10 J=1,I-1 R = 0. DO 5 K=1,3 R = R + (VERT(K,I)-VERT(K,J))**2 5 CONTINUE R = SQRT(R) IF(ABS(R-2.0).GT.0.1) GOTpgplot/examples/pgdemo3.f010064400040640000322000000437200634733206000160660ustar00tjpcitmbr00000400000017 PROGRAM PGDEM3 C----------------------------------------------------------------------- C Demonstration program for PGPLOT contouring routines. C----------------------------------------------------------------------- INTEGER PGBEG WRITE (*,'(A)') ' Demonstration of PGPLOT contouring routines' C C Call PGBEG to initiate PGPLOT and open the output device; PGBEG C will prompt the user to supply the device name and type. C IF (PGBEG(0,'?',1,1) .NE. 1) STOP C C Call the demonstration subroutines. C WRITE (*,'(A)') ' Routine PGCONT' CALL PGEX31 WRITE (*,'(A)') ' Routine PGCONS' CALL PGEX32 WRITE (*,'(A)') ' Routine PGCONT with PGCONL labels' CALL PGEX36 WRITE (*,'(A)') ' Routine PGCONB' CALL PGEX33 WRITE (*,'(A)') ' Routine PGCONX with arrow labels' CALL PGEX37 WRITE (*,'(A)') ' Routine PGCONX' CALL PGEX34 WRITE (*,'(A)') ' Routine PGCONF' CALL PGEXX1 C C Finally, call PGEND to terminate things properly. C CALL PGEND C----------------------------------------------------------------------- END SUBROUTINE PGEX31 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONT. C----------------------------------------------------------------------- INTEGER I,J REAL F(40,40),FMIN,FMAX,ALEV(1),TR(6) DATA TR/0.,1.,0.,0.,0.,1./ C C Compute a suitable function. C FMIN = 0.0 FMAX = 0.0 DO 20 I=1,40 DO 10 J=1,40 F(I,J) = COS(0.3*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/40.0 FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL PGSVP(0.05,0.95,0.05,0.95) CALL PGSWIN(1.0,40.0,1.0,40.0) CALL PGBOX('bcts',0.0,0,'bcts',0.0,0) CALL PGMTXT('t',1.0,0.0,0.0,'Contouring using PGCONT') C C Draw the map. PGCONT is called once for each contour, using C different line attributes to distinguish contour levels. C CALL PGBBUF DO 30 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSCI(2) CALL PGSLS(2) ELSE CALL PGSCI(3) CALL PGSLS(1) END IF CALL PGCONT(F,40,40,1,40,1,40,ALEV,-1,TR) 30 CONTINUE CALL PGSLW(1) CALL PGSLS(1) CALL PGSCI(1) CALL PGEBUF END SUBROUTINE PGEX32 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONS. C----------------------------------------------------------------------- INTEGER I,J REAL F(40,40),FMIN,FMAX,ALEV(1),TR(6) DATA TR/0.,1.,0.,0.,0.,1./ C C Compute a suitable function. C FMIN = 0.0 FMAX = 0.0 DO 20 I=1,40 DO 10 J=1,40 F(I,J) = COS(0.3*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/40.0 FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL PGBOX('bcts',0.0,0,'bcts',0.0,0) CALL PGMTXT('t',1.0,0.0,0.0,'Contouring using PGCONS') C C Draw the map. PGCONS is called once for each contour, using C different line attributes to distinguish contour levels. C CALL PGBBUF DO 40 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSCI(2) CALL PGSLS(2) ELSE CALL PGSCI(3) CALL PGSLS(1) END IF CALL PGCONS(F,40,40,1,40,1,40,ALEV,-1,TR) 40 CONTINUE CALL PGSLW(1) CALL PGSLS(1) CALL PGSCI(1) CALL PGEBUF END SUBROUTINE PGEX33 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONB. C----------------------------------------------------------------------- REAL BLANK PARAMETER (BLANK=-1.2E20) INTEGER I,J REAL F(40,40),FMIN,FMAX,ALEV(1),TR(6),X,Y,R DATA TR/0.,1.,0.,0.,0.,1./ C C Compute a suitable function. C FMIN = 0.0 FMAX = 0.0 DO 20 I=1,40 DO 10 J=1,40 F(I,J) = COS(0.3*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/40.0 FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE C C "Blank" the data outside an annulus. C DO 60 I=1,40 DO 50 J=1,40 R = SQRT((I-20.5)**2 + (J-20.5)**2) IF (R.GT.20.0 .OR. R.LT.3.0) F(I,J) = BLANK 50 CONTINUE 60 CONTINUE C CALL PGPAGE CALL PGBOX('bcts',0.0,0,'bcts',0.0,0) CALL PGMTXT('t',1.0,0.0,0.0,'Contouring using PGCONB') CALL PGBBUF DO 80 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSCI(2) CALL PGSLS(2) ELSE CALL PGSCI(3) CALL PGSLS(1) END IF CALL PGCONB(F,40,40,1,40,1,40,ALEV,-1,TR,BLANK) 80 CONTINUE CALL PGEBUF C C Mark the blanked points for easy identification. C CALL PGBBUF CALL PGSCI(1) DO 100 I=1,40 DO 90 J=1,40 IF (F(I,J).EQ.BLANK) THEN X = TR(1) + REAL(I)*TR(2) + REAL(J)*TR(3) Y = TR(4) + REAL(I)*TR(5) + REAL(J)*TR(6) CALL PGPT1(X, Y, -1) END IF 90 CONTINUE 100 CONTINUE CALL PGEBUF END SUBROUTINE PGEX34 C----------------------------------------------------------------------- C This program is intended to demonstrate the use of the PGPLOT routine C PGCONX. As an example, we take data defined on a sphere. We want to C draw a contour map of the data on an equal-area projection of the C surface of the sphere; we choose the Hammer-Aitoff equal-area C projection centered on Declination (latitude) 0, Right Ascension C (longitude) 0. The data are defined at 2-degree intervals in both C coordinates. We thus need a data array dimensioned 181 by 91; the C array index runs from -90 to +90 in declination (91 elements) and C from -180 to +180 in right ascension (181 elements). The data at -180 C and +180 must be identical, of course, but they need to be duplicated C in the array as these two longitudes appear on opposite sides of the C map. C----------------------------------------------------------------------- REAL PI, RPDEG PARAMETER (PI=3.14159265359) PARAMETER (RPDEG=PI/180.0) INTEGER I, J REAL RA, DEC, B, L, XC(181), YC(181) REAL Q(181,91), C(9) EXTERNAL PLCAIT C C Call PGENV to create a rectangular window of 4 x 2 units. This is C the bounding rectangle of the plot. The JUST argument is 1 C to get equal scales in x and y. C CALL PGBBUF CALL PGENV(-2.0, 2.0, -1.0, 1.0, 1, -2) CALL PGLAB('Right Ascension', 'Declination', ' ') CALL PGMTXT('t',2.0,0.0,0.0, 1 'Contouring on a non-Cartesian grid using PGCONX') CALL PGSCH(0.6) CALL PGMTXT('b',8.0,0.0,0.0, 1 'Hammer-Aitoff Equal-Area Projection of the Sphere') CALL PGSCH(1.0) C C Draw 7 lines of constant longitude at longitude 0, 60, 120, ..., C 360 degrees. Each line is made up of 90 straight-line segments. C DO 20 J=1,7 RA = (-180.+(J-1)*60.)*RPDEG DO 10 I=1,91 DEC = 2*(I-46)*RPDEG CALL AITOFF(DEC,RA,XC(I),YC(I)) 10 CONTINUE CALL PGLINE(91,XC,YC) 20 CONTINUE C C Draw 5 lines of constant latitude at latitudes -60, -30, 0, 30, C 60 degrees. Each line is made up of 360 straight-line segments. C DO 40 J=1,5 DEC = (-60.+(J-1)*30.)*RPDEG DO 30 I=1,181 RA = 2*(I-91)*RPDEG CALL AITOFF(DEC,RA,XC(I),YC(I)) 30 CONTINUE CALL PGLINE(181,XC,YC) 40 CONTINUE CALL PGEBUF C C Compute the data to be contoured. In practice the data might be read C in from an external file. In this example the data are computed: they C are the galactic latitudes of the points on the sphere. Thus the C contours will be lines of constant galactic latitude. C DO 60 J=1,91 DEC = 2*(J-46)*RPDEG DO 50 I=1,181 RA = 2*(I-91)*RPDEG CALL GALACT(RA, DEC, B,L) Q(I,J) = B 50 CONTINUE 60 CONTINUE C C Draw the contour map using PGCONX. Contours at 0, 20, 40, 60, 80. C DO 70 I=1,9 C(I) = -100.0 +I*20.0 70 CONTINUE CALL PGBBUF CALL PGSCI(2) CALL PGCONX(Q, 181, 91, 1, 181, 1, 91, C, 9, PLCAIT) CALL PGSCI(1) CALL PGEBUF END SUBROUTINE PLCAIT(VISBLE, X, Y, Z) INTEGER VISBLE REAL X,Y,Z C----------------------------------------------------------------------- C Plotting subroutine for PGCONX. This routine converts the input C coordinates (latitude and longitude) into the projected coordinates C (x and y), and moves or draws as requested by VISBLE. C----------------------------------------------------------------------- REAL PI, RPDEG PARAMETER (PI=3.14159265359) PARAMETER (RPDEG=PI/180.0) REAL B, L, XWORLD, YWORLD B = 2.0*(Y-46.0)*RPDEG L = 2.0*(X-91.0)*RPDEG CALL AITOFF(B, L, XWORLD, YWORLD) IF (VISBLE.EQ.0) THEN CALL PGMOVE(XWORLD, YWORLD) ELSE CALL PGDRAW(XWORLD, YWORLD) END IF END SUBROUTINE AITOFF(B,L,X,Y) C----------------------------------------------------------------------- C Hammer-Aitoff projection. C C Input: latitude and longitude (B,L) in radians C Output: cartesian (X,Y) in range +/-2, +/-1 C----------------------------------------------------------------------- REAL L,B,X,Y,L2,DEN C L2 = L/2.0 DEN = SQRT(1.0+COS(B)*COS(L2)) X = 2.0*COS(B)*SIN(L2)/DEN Y = SIN(B)/DEN END SUBROUTINE GALACT(RA,DEC,GLAT,GLONG) C----------------------------------------------------------------------- C Convert 1950.0 equatorial coordinates (RA, DEC) to galactic C latitude and longitude (GLAT, GLONG). C C Arguments: C RA, DEC (input): 1950.0 RA and Dec (radians). C GLAT, GLONG (output): galactic latitude and longitude C (degrees). C C Reference: e.g., D. R. H. Johnson and D. R. Soderblom, A. J. v93, C p864 (1987). C----------------------------------------------------------------------- REAL RA, RRA, DEC, RDEC, CDEC, R(3,3), E(3), G(3) REAL RADDEG, GLAT, GLONG INTEGER I, J DATA R/-.066988740D0, .492728466D0,-.867600811D0,-.872755766D0, $ -.450346958D0,-.188374601D0,-.483538915D0, .744584633D0, $ .460199785D0/ DATA RADDEG/57.29577951D0/ C----------------------------------------------------------------------- RRA = RA RDEC = DEC CDEC = COS(RDEC) E(1) = CDEC*COS(RRA) E(2) = CDEC*SIN(RRA) E(3) = SIN(RDEC) DO 20 I=1,3 G(I) = 0.0 DO 10 J=1,3 G(I) = G(I) + E(J)*R(I,J) 10 CONTINUE 20 CONTINUE GLAT = ASIN(G(3))*RADDEG GLONG = ATAN2(G(2),G(1))*RADDEG IF (GLONG.LT.0.0) GLONG = GLONG+360.0 RETURN C----------------------------------------------------------------------- END SUBROUTINE PGEX37 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONX. C----------------------------------------------------------------------- INTEGER I,J REAL F(40,40),FMIN,FMAX,ALEV(1) EXTERNAL PLCARO C C Compute a suitable function. C FMIN = 0.0 FMAX = 0.0 DO 20 I=1,40 DO 10 J=1,40 F(I,J) = COS(0.3*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/40.0 FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL PGSVP(0.05,0.95,0.05,0.95) CALL PGSWIN(1.0,40.0,1.0,40.0) CALL PGBOX('bcts',0.0,0,'bcts',0.0,0) CALL PGMTXT('t',1.0,0.0,0.0, : 'Contouring using PGCONX with arrows') C C Draw the map. PGCONX is called once for each contour, using C different line attributes to distinguish contour levels. C CALL PGBBUF DO 30 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSCI(2) CALL PGSLS(2) ELSE CALL PGSCI(3) CALL PGSLS(1) END IF CALL PGCONX(F,40,40,1,40,1,40,ALEV,-1,PLCARO) 30 CONTINUE CALL PGSLW(1) CALL PGSLS(1) CALL PGSCI(1) CALL PGEBUF END SUBROUTINE PGEX36 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONT and PGCONL. C----------------------------------------------------------------------- INTEGER I,J REAL F(40,40),FMIN,FMAX,ALEV(1),TR(6) CHARACTER*32 LABEL DATA TR /0.0, 1.0, 0.0, 0.0, 0.0, 1.0/ C C Compute a suitable function. C FMIN = 0.0 FMAX = 0.0 DO 20 I=1,40 DO 10 J=1,40 F(I,J) = COS(0.3*SQRT(I*2.)-0.4*J/3.)*COS(0.4*I/3)+ 1 (I-J)/40.0 FMIN = MIN(F(I,J),FMIN) FMAX = MAX(F(I,J),FMAX) 10 CONTINUE 20 CONTINUE C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL PGBOX('bcts',0.0,0,'bcts',0.0,0) CALL PGMTXT('t',1.0,0.0,0.0, 1 'Contouring using PGCONT and PGCONL labels') C C Draw the map. PGCONT is called once for each contour, using C different line attributes to distinguish contour levels. C CALL PGBBUF DO 40 I=1,21 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 IF (MOD(I,5).EQ.0) THEN CALL PGSLW(3) ELSE CALL PGSLW(1) END IF IF (I.LT.10) THEN CALL PGSCI(2) CALL PGSLS(2) ELSE CALL PGSCI(3) CALL PGSLS(1) END IF CALL PGCONT(F,40,40,1,40,1,40,ALEV,-1,TR) 40 CONTINUE CALL PGSLW(1) CALL PGSLS(1) CALL PGEBUF C C Label the contours with PGCONL. Only even-numbered contours C are labelled. C CALL PGBBUF DO 50 I=2,21,2 ALEV(1) = FMIN + (I-1)*(FMAX-FMIN)/20.0 WRITE (LABEL,'(I2)') I C WRITE (LABEL,'(F8.2)') ALEV IF (I.LT.10) THEN CALL PGSCI(2) ELSE CALL PGSCI(3) END IF CALL PGCONL(F,40,40,1,40,1,40,ALEV,TR,LABEL,16,8) 50 CONTINUE CALL PGSCI(1) CALL PGEBUF END SUBROUTINE PLCARO(VISBLE, X, Y, Z) INTEGER VISBLE REAL X,Y,Z C----------------------------------------------------------------------- C Plotting subroutine for PGCONX. This routine labels contours with C arrows. Arrows point clockwise around minima, anticlockwise around C maxima. Arrows are drawn on 1/16 of contour line segments. C----------------------------------------------------------------------- REAL XP, YP INTEGER I SAVE I DATA I /0/ C I = MOD(I+1,16) IF (VISBLE.EQ.0) THEN I = 0 CALL PGMOVE(X, Y) ELSE IF (I.EQ.8) THEN C -- Draw line segment with arrow at midpoint CALL PGQPOS(XP,YP) CALL PGARRO(XP, YP, (X+XP)*0.5, (Y+YP)*0.5) CALL PGDRAW(X, Y) ELSE C -- Draw plain line segment CALL PGDRAW(X, Y) END IF END SUBROUTINE PGEXX1 C----------------------------------------------------------------------- C Demonstration of contouring routine PGCONF. C----------------------------------------------------------------------- INTEGER NX, NY, NC PARAMETER (NX=51, NY=51, NC=9) INTEGER I, J REAL Z(NX,NY),TR(6), R REAL X, Y, XMIN, XMAX, YMIN, YMAX, DX, DY, MU, C(NC) DATA C /3.0, 3.2, 3.5, 3.6, 3.766413, 4.0 ,5.0, 10.0, 100.0/ C C Compute a suitable function. This is the test function used by C W. V. Snyder, Algorithm 531, Contour Plotting, ACM Trans. Math. C Softw. v.4, pp.290-294 (1978). C XMIN = -2.0 XMAX = 2.0 YMIN =-2.0 YMAX = 2.0 MU = 0.3 DX = (XMAX-XMIN)/FLOAT(NX-1) DY = (YMAX-YMIN)/FLOAT(NY-1) TR(1) = XMIN - DX TR(2) = DX TR(3) = 0.0 TR(4) = YMIN - DY TR(5) = 0.0 TR(6) = DY DO 20 I=1,NX X = TR(1) + I*TR(2) DO 10 J=1,NY Y = TR(4) + J*TR(6) Z(I,J) = (1.0-MU)*(2.0/SQRT((X-MU)**2+Y**2)+(X-MU)**2+Y**2) * + MU*(2.0/SQRT((X+1.0-MU)**2+Y**2)+(X+1.0-MU)**2+Y**2) 10 CONTINUE 20 CONTINUE C C Clear the screen. Set up window and viewport. C CALL PGPAGE CALL PGVSTD(0.05,0.95,0.05,0.95) CALL PGWNAD(XMIN, XMAX, YMIN, YMAX) C C Fill contours with PGCONF. C CALL PGSFS(1) DO 30 I=1, NC-1 R = 0.5+0.5*REAL(I-1)/REAL(NC-1) CALL PGSCR(I+10, R, R, R) CALL PGSCI(I+10) CALL PGCONF(Z,NX,NY,1,NX,1,NY,C(I),C(I+1),TR) 30 CONTINUE C C Draw the contour lines with PGCONT. C CALL PGSCI(3) CALL PGCONT(Z,NX,NY,1,NX,1,NY,C,NC,TR) C C Labels and box. C CALL PGSCI(1) CALL PGSCH(0.6) CALL PGBOX('bctsin',1.0,10,'bctsinv',1.0,10) CALL PGSCH(1.0) CALL PGMTXT('t',1.0,0.0,0.0,'Contour filling using PGCONF') C END s of constant latitude at latitudes -60, -30, 0,pgplot/examples/pgdemo6.f010064400040640000322000000044310627570033200160660ustar00tjpcitmbr00000400000017 PROGRAM PGDEM6 C----------------------------------------------------------------------- C Test program for PGPLOT: test of Cursor C----------------------------------------------------------------------- INTEGER PGBEG, PGBAND INTEGER JUNK, MODE CHARACTER*1 CH REAL X,Y C WRITE(*,*) ' This program demonstrates the use of routine', : ' PGBAND. It' WRITE(*,*) ' requires a graphics device with a cursor.', : ' Position the cursor' WRITE(*,*) ' anywhere in the window. Press any key (or a mouse', : ' button if' WRITE(*,*) ' the device has a mouse supported by PGPLOT); the', : ' program' WRITE(*,*) ' draws a marker at the current cursor position and', : ' reports the' WRITE(*,*) ' current cursor position [bottom left corner is', : ' (0,0); top' WRITE(*,*) ' right is (1,1)] and the ASCII code of the key', : ' that you' WRITE(*,*) ' pressed. To exit from the program, type a slash', : ' (/), ctrl-D,' WRITE(*,*) ' or ctrl-Z. The + key toggles between normal', : ' cursor, cross-hair,' WRITE(*,*) ' and other cursor modes (on supporting devices).' C C Open device for graphics. C IF (PGBEG(0,'?',1,1) .NE. 1) STOP C C Clear the screen. Draw a frame at the physical extremities of the C plot, using full-screen viewport and standard window. C CALL PGPAGE CALL PGSVP(0.0,1.0,0.0,1.0) CALL PGSWIN(0.0,1.0,0.0,1.0) CALL PGBOX('bcts',0.1,5,'bcts',0.1,5) C C Loop to read and display cursor position. Initial position for cursor C is center of viewport. C X = 0.5 Y = 0.5 MODE = 0 10 CONTINUE JUNK = PGBAND(MODE, 1, X, Y, X,Y,CH) WRITE (*, '(2F8.3,I4)') X,Y,ICHAR(CH) C Check for exit IF (CH.EQ.'/' .OR. CH.EQ.CHAR(0) .OR. CH.EQ.CHAR(4) .OR. : CH.EQ.CHAR(26)) GOTO 20 C Check for switch of cursor type. IF (CH.EQ.'+') THEN MODE = MOD(MODE+1,8) WRITE (*,*) 'Cursor mode:', MODE GOTO 10 END IF CALL PGPT1(X, Y, ICHAR(CH)) GOTO 10 C C Close the device and exit. C 20 CALL PGEND END pgplot/sys/grdate.c010064400040640000322000000034350566053774000150030ustar00tjpcitmbr00000400000017#include #include #ifdef PG_PPU #define GRDATE grdate_ #else #define GRDATE grdate #endif /**GRDATE -- get date and time as character string (Cray) *+ * SUBROUTINE GRDATE(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. * To receive the whole string, the STRING should be declared * CHARACTER*17. * * Arguments: * STRING : receives date and time, truncated or extended with * blanks as necessary. * SLEN : receives the number of characters in STRING, excluding * trailing blanks. This will always be 17, unless the length * of the string supplied is shorter. *-- * 09-Nov-1994 - [mcs] Fortran callable C version for CRAY. *----------------------------------------------------------------------- */ void GRDATE(string, slen, maxlen) char *string; int *slen; int maxlen; { char vtime[18]; /* Output string compilation buffer */ char *utime; /* Returned string from ctime() */ time_t x; /* Time returned by time() */ int i; /* * Get the standard C time string. */ time(&x); utime = ctime(&x); /* * Copy a re-organised version of the time string into vtime[]. */ vtime[0] = utime[8]; vtime[1] = utime[9]; vtime[2] = '-'; vtime[3] = utime[4]; vtime[4] = utime[5]; vtime[5] = utime[6]; vtime[6] = '-'; vtime[7] = utime[20]; vtime[8] = utime[21]; vtime[9] = utime[22]; vtime[10] = utime[23]; vtime[11] = ' '; strncpy(vtime+12, utime+11, 5); vtime[17]='\0'; /* * Copy up to maxlen characters of vtime into the output FORTRAN string. */ strncpy(string, vtime, maxlen); *slen = (maxlen < 17) ? maxlen : 17; /* * Pad the FORTRAN string with spaces. */ for(i=17; i */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) #ifdef PG_PPU #define GRGETC grgetc_ #else #define GRGETC grgetc #endif void GRGETC(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct termios term, saveterm; int i; int nextch; static int init=1; static int raw=0; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { tcgetattr(0, &term); saveterm = term; term.c_lflag &= ~( ICANON ); term.c_cc[VMIN] = 1; tcsetattr(0, TCSADRAIN, &term); raw = 1; } tcflush(0, TCIOFLUSH); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tcsetattr(0, TCSADRAIN, &saveterm); raw = 0; } return; } pgplot/sys/grgmem.c010064400040640000322000000015540640310234200147710ustar00tjpcitmbr00000400000017#include #include /* Fortran callable memory allocator Called as : ier = grgmem (size,pointer) where : size is an integer size of memory to allocate pointer is an integer (integer*8 on some systems) to return the pointer into */ #ifdef PG_PPU #define GRGMEM grgmem_ #define GRFMEM grfmem_ #else #define GRGMEM grgmem #define GRFMEM grfmem #endif int GRGMEM(size, pointer) int *size; void **pointer; { *pointer = malloc(*size); /* printf("grgmem: %d %p\n", *size, *pointer); */ if (*pointer == NULL) return 0; return 1; } /* Fortran callable memory deallocator Called as : ier = grfmem (size,pointer) where : size is an integer size of memory to deallocate (not used) pointer is an integer that contains the pointer */ int GRFMEM(size, pointer) int *size; void **pointer; { free(*pointer); return 1; } pgplot/sys/grtermio.c010064400040640000322000000071740570061254100153550ustar00tjpcitmbr00000400000017#ifndef _POSIX_SOURCE #define _POSIX_SOURCE #endif /* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRPTER. */ #include #include #ifdef PG_PPU #define GROTER groter_ #define GRWTER grwter_ #define GRCTER grcter_ #define GRPTER grpter_ #else #define GROTER groter #define GRWTER grwter #define GRCTER grcter #define GRPTER grpter #endif /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * groter O The open channel number (-1 indicates an error) */ int GROTER(cdev, ldev, cdev_len) char *cdev; int *ldev; int cdev_len; { int fd; /* The returned file descriptor */ char name[64]; /* A copy of the given terminal device name */ /* * Make a copy of the given file if there is sufficient room in name[]. */ if(*ldev <= sizeof(name)-1) { strncpy(name, cdev, *ldev); name[*ldev] = '\0'; } else { fprintf(stderr, "groter: Terminal file name too long.\n"); return -1; }; /* * Open the terminal. */ if((fd = open(name, 2)) == -1) { perror(name); return -1; }; return fd; } /* Close a previously opened channel. * * fd I The channel number to be closed */ void GRCTER(fd) int *fd; { close(*fd); return; } /* Write lbuf bytes from cbuf to the channel fd. Data is written without * any formating. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return */ void GRWTER(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; int *lbuf; int cbuf_len; { int nwritten = write (*fd, cbuf, *lbuf); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read */ void GRPTER(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom; int *lprom; char *cbuf; int *lbuf; int cprom_len; int cbuf_len; { char *buff = cbuf; /* C pointer to FORTRAN string */ int ndone=0; /* The number of characters read */ struct termios term; /* Terminal mode flags */ /* * Get the current set of terminal mode flags. */ if(tcgetattr(*fd, &term)==0) { struct termios saveterm; /* Saved terminal attributes */ int ntry; /* The number of characters still to be read */ int nread; /* The number of characters read in one iteration */ /* * Save the existing terminal mode flags to be restored later. */ saveterm = term; /* * Enable raw single character input. */ term.c_lflag &= ~ICANON; term.c_cc[VMIN] = 1; /* * Install the new terminal flags after first waiting for all pending * output to be delivered to the terminal and after discarding any * lingering input. */ tcsetattr(*fd, TCSAFLUSH, &term); /* * Prompt for input. */ if(*lprom>0) write(*fd, cprom, *lprom); /* * Read up to 'ntry' characters from the terminal. */ ndone = 0; ntry = *lbuf; do { nread = read(*fd, &buff[ndone], ntry); ndone += nread; ntry -= nread; } while(nread>0 && ntry>0); /* * Restore the previous terminal mode flags. */ tcsetattr(*fd, TCSAFLUSH, &saveterm); }; *lbuf=ndone; return; } pgplot/sys/grflun.f010064400040640000322000000005740565756130100150320ustar00tjpcitmbr00000400000017C*GRFLUN -- free a Fortran logical unit number (Sun/Convex-UNIX) C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. [This version C does nothing.] C C Arguments: C LUN : the logical unit number to free. C-- C 25-Nov-1988 C----------------------------------------------------------------------- RETURN END pgplot/sys/grgcom.f010064400040640000322000000020270565757526600150250ustar00tjpcitmbr00000400000017C*GRGCOM -- read with prompt from user's terminal (Sun/Convex-UNIX) C+ INTEGER FUNCTION GRGCOM(STRING, PROMPT, L) CHARACTER*(*) STRING, PROMPT INTEGER L C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C STRING : (output) receives the string read from the terminal. C PROMPT : (input) prompt string. C L : (output) length of STRING. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 9-Feb-1988 C 10-Feb-1990 revised to always read from stdin (unit 5), but issue a C prompt only when device is a terminal. C----------------------------------------------------------------------- INTEGER IER C GRGCOM = 0 L = 0 IER = 0 WRITE (*, '(1X,A,$)', IOSTAT=IER) PROMPT IF (IER.EQ.0) READ (*, '(A)', IOSTAT=IER) STRING IF (IER.EQ.0) GRGCOM = 1 L = LEN(STRING) 10 IF (STRING(L:L).NE.' ') GOTO 20 L = L-1 GOTO 10 20 CONTINUE END pgplot/sys/grlgtr.f010064400040640000322000000011570567534542500150430ustar00tjpcitmbr00000400000017C*GRLGTR -- translate logical name (dummy version) C+ SUBROUTINE GRLGTR (NAME) CHARACTER*(*) NAME C C Recursive translation of a logical name. C This is used in the parsing of device specifications in the C VMS implementation of PGPLOT. In other implementations, it may C be replaced by a null routine. C C Argument: C NAME (input/output): initially contains the name to be C inspected. If an equivalence is found it will be replaced C with the new name. If not, the old name will be left there. C-- C 19-Dec-1994 C----------------------------------------------------------------------- END pgplot/sys/grglun.f010064400040640000322000000017700565756130100150320ustar00tjpcitmbr00000400000017C*GRGLUN -- get a Fortran logical unit number (Sun/Convex-UNIX) C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Get an unused Fortran logical unit number. C Returns a Logical Unit Number that is not currently opened. C After GRGLUN is called, the unit should be opened to reserve C the unit number for future calls. Once a unit is closed, it C becomes free and another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 C as older software will often use these units without warning. C C Arguments: C LUN : receives the logical unit number, or -1 on error. C-- C 12-Feb-1989 [AFT/TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL QOPEN C--- DO 10 I=99,10,-1 INQUIRE (UNIT=I, OPENED=QOPEN) IF (.NOT.QOPEN) THEN LUN = I RETURN END IF 10 CONTINUE CALL GRWARN('GRGLUN: out of units.') LUN = -1 RETURN END pgplot/sys/grgmsg.f010064400040640000322000000011000565756130100150050ustar00tjpcitmbr00000400000017 C*GRGMSG -- print system message (Sun/Convex-UNIX) C+ SUBROUTINE GRGMSG (STATUS) INTEGER STATUS C C This routine obtains the text of the VMS system message corresponding C to code STATUS, and displays it using routine GRWARN. On non-VMS C systems, it just displays the error number. C C Argument: C STATUS (input): 32-bit system message code. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER*10 BUFFER C WRITE (BUFFER, '(I10)') STATUS CALL GRWARN('system message number: '//BUFFER) END pgplot/sys/groptx.f010064400040640000322000000014440566001732300150470ustar00tjpcitmbr00000400000017C*GROPTX -- open input/output text file [Unix] C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE) INTEGER UNIT, MODE CHARACTER*(*) NAME, DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C MODE : 0 to open for reading, 1 to open for writing. C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER IF (MODE.EQ.1) THEN OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER) ELSE OPEN (UNIT=UNIT, FILE=NAME, STATUS='OLD', IOSTAT=IER) END IF GROPTX = IER C----------------------------------------------------------------------- END pgplot/sys/grtrml.f010064400040640000322000000012600566002210200150160ustar00tjpcitmbr00000400000017 C*GRTRML -- get name of user's terminal (UNIX) C+ SUBROUTINE GRTRML(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the device name of the user's terminal, if any. In Sun/Convex-UNIX, C the name of the terminal is always /dev/tty. C C Arguments: C STRING : receives the terminal name, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 19-Jan-1988 C----------------------------------------------------------------------- STRING = '/dev/tty' L = MIN(LEN(STRING),8) END pgplot/sys/grtter.f010064400040640000322000000013670570061324100150330ustar00tjpcitmbr00000400000017 C*GRTTER -- test whether device is user's terminal (Sun/Convex-UNIX) C+ SUBROUTINE GRTTER(STRING, SAME) CHARACTER*(*) STRING LOGICAL SAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C STRING : (input) the device name to be tested. C SAME : (output) .TRUE. is STRING contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER*64 T INTEGER L C CALL GRTRML(T, L) SAME = (STRING.EQ.T(:L)) END pgplot/sys/gruser.c010064400040640000322000000022100566054260700150300ustar00tjpcitmbr00000400000017/* **GRUSER -- get user name (POSIX) *+ * SUBROUTINE GRUSER(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the name of the user running the program. * * Arguments: * STRING : receives user name, truncated or extended with * blanks as necessary. * L : receives the number of characters in VALUE, excluding * trailing blanks. *-- * 08-Nov-1994 *----------------------------------------------------------------------- */ #ifdef PG_PPU #define GRUSER gruser_ #else #define GRUSER gruser #endif char *getlogin(); void GRUSER(string, length, maxlen) char *string; int *length; int maxlen; { int i; /* * Get the login name of the PGPLOT user. */ char *user = getlogin(); /* * If the user name is not available substitute an empty string. */ if(!user) user = ""; /* * Copy the user name to the output string. */ for(i=0; i #include #include #include #ifdef PG_PPU #define GROFIL grofil_ #define GRWFIL grwfil_ #define GRCFIL grcfil_ #define GRWFCH grwfch_ #else #define GROFIL grofil #define GRWFIL grwfil #define GRCFIL grcfil #define GRWFCH grwfch #endif /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNAME) * INTEGER GROFIL * CHARACTER*(*) FNAME * * Opens file FNAME for writing. * GROFIL returns the file descriptor for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, ARRAY) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occurred while opening the file. *- */ int GROFIL(fname, fname_len) char *fname; int fname_len; { char *name = fname; /* C pointer to FORTRAN string */ int slen = fname_len; /* Length of the FORTRAN string */ char *buff=0; /* Dynamically allocated copy of name[] */ int fd = -1; /* File descriptor to be returned */ /* * Determine how long the FORTRAN string is by searching for the last * non-blank character in the string. */ while(slen>0 && name[slen-1]==' ') slen--; /* * Dynamically allocate a buffer to copy the FORTRAN string into. */ buff = (char *) malloc((slen+1) * sizeof(char)); if(buff) { /* * Make a C string copy of the FORTRAN string. */ strncpy(buff, name, slen); buff[slen] = '\0'; /* * Check for stdout. */ if (slen == 1 && buff[0] == '-') { fd = 1; } else { /* * Open the file and return its descriptor. */ fd = open(buff, O_WRONLY | O_CREAT | O_TRUNC, 0666); } free(buff); } else { fprintf(stderr, "grofil: Insufficient memory\n"); }; return fd; } /* **&GRCFIL -- Close file from GRFILEIO access *+ * FUNCTION GRCFIL (FD) * INTEGER GRCFIL (FD) * * Closes the file with descriptor FD from GRFILEIO access. GRCFIL returns * 0 when properly closed. Otherwise, use PERRORF to report the error. * * Usage: * IOS = GRCFIL (FD) * or: * CALL GRCFIL (FD) * * In the last case the return code is ignored. * * Arguments: * FD (input) : File descriptor returned by GROFIL. * GRCFIL (output) : Error code or 0 on proper closing. *- */ int GRCFIL(fd) int *fd; { if ((*fd) == 1) { return 0; } else{ return close(*fd); } } /* **&GRWFIL -- GRFILEIO write routine *+ * FUNCTION GRWFIL (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFIL * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFIL. If * GRWFIL < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFIL (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFIL(fd, nbytes, buf) int *fd, *nbytes; char *buf; { return write(*fd, (void *) buf, *nbytes); } /* **&GRWFCH -- GRFILEIO write FORTRAN character STRING routine *+ * FUNCTION GRWFCH (FD, STRING) * INTEGER FD, GRWFCH * CHARACTER*(*) STRING * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call). The string STRING contains the data that has * to be written. * The function returns the number of bytes actually written in GRWFCH. If * GRWFCH < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * STRING (input) : String containing the characterst to be written * GRWFCH (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFCH(fd, buf, buf_len) int *fd; char *buf; int buf_len; { return write(*fd, (void *) buf, buf_len); } efine GRCFIL grcfil #define GRWFCH grwfch #endif /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNpgplot/sys/grsy00.f010064400040640000322000000062170576744134000146630ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C----------------------------------------------------------------------- INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END pgplot/sys_aix/xlf_cc.conf010064400040640000322000000100220656367443300163310ustar00tjpcitmbr00000400000017# The AIX xlf FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="xlf" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -qnoescape" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd -suffix '' -true 1 -false 0" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_aix/aaaread.me010064400040640000322000000022640656464453500161370ustar00tjpcitmbr00000400000017pgplot/sys_aix The *.conf files in this directory are for use with IBM RS/6000 machines running AIX. PGPLOT has been tested with AIX 3.2.5 and xlf 3.2. xlf_cc.conf Problems: (1) xlf complains about DATA initialization of variables in COMMON in routines gropen and pgbeg, but it appears to do the correct thing. You can ignore these messages. (2) Some PGPLOT device drivers, e.g., lxdriv, use non-standard ENCODE statements that xlf rejects. These can be replaced with in-memory WRITE statements if necessary. I have not done this because I have no way to test that the modified drivers still work. Let me know if you do change these drivers successfully. g77_gcc.conf This configuration file has not been tested extensively: feedback is requested. If make fails, make any necessary changes in the configuration file and rerun makemake. This configuration file does not make a shared library (libpgplot.so) because I don't know the necessary commands for an AIX system. Note that not all drivers can be compiled with g77. If you encounter compilation errors for file *driv.f, edit the drivers.list file to deselect the line referring to this driver and rerun makemake. Tim Pearson 13 Aug 1998 pgplot/sys_aix/g77_gcc.conf010064400040640000322000000100510724407250100162760ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL -I/usr/local/include" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk8.3 -ltcl8.3 $LIBS -ldl -lsocket -lnsl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_alliant/fortran_cc.conf010064400040640000322000000100010656367443300200530ustar00tjpcitmbr00000400000017# The Alliant "fortran" FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="fortran" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="alliant" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" _PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="alliant" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking mpgplot/sys_alliant/grgetc.c010064400040640000322000000053600505612750300165020ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) grgetc_(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_alliant/grdate.f010064400040640000322000000020620465533460200165000ustar00tjpcitmbr00000400000017C*GRDATE -- get date and time as character string (Alliant-UNIX) C+ SUBROUTINE GRDATE(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the STRING should be declared C CHARACTER*17. C C Arguments: C STRING : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 28-Jul-1988 C 23-Oct-1989 ALF. Conforms to Alliant use of FDATE. C----------------------------------------------------------------------- CHARACTER*24 UTIME, FDATE CHARACTER*17 VTIME C UTIME = FDATE() VTIME(1:2) = UTIME(9:10) VTIME(3:3) = '-' VTIME(4:6) = UTIME(5:7) VTIME(7:7) = '-' VTIME(8:11) = UTIME(21:24) VTIME(12:12) = ' ' VTIME(13:17) = UTIME(12:16) STRING = VTIME L = MIN(17, LEN(STRING)) END pgplot/sys_alliant/gruser.f010064400040640000322000000014670465533460300165520ustar00tjpcitmbr00000400000017C*GRUSER -- get user name (Alliant-UNIX) C+ SUBROUTINE GRUSER(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the name of the user running the program. C C Arguments: C STRING : receives user name, truncated or extended with C blanks as necessary. C L : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 19-Jan-1988 C 23-Oct-1989 ALF. Change to Alliant use of GETLOG. C----------------------------------------------------------------------- INTEGER I CHARACTER*31 GETLOG C STRING = GETLOG() IF (STRING.EQ.' ') THEN L = 0 ELSE DO 10 I=LEN(STRING),1,-1 L = I IF (STRING(I:I).NE.' ') GOTO 20 10 CONTINUE L = 0 20 CONTINUE END IF END pgplot/sys_alliant/grtermio.c010064400040640000322000000057110505613041500170530ustar00tjpcitmbr00000400000017/* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRRTER. */ #include long int groter_(cdev, ldev, cdev_len) char *cdev; long int *ldev; int cdev_len; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * cdev_len I Used by Fortran compiler to pass character length * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } grcter_(fd) int *fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } grwter_(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; long int *lbuf; int cbuf_len; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return * cbuf_len I Used by Fortran compiler to pass character length */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } grpter_(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int cprom_len, cbuf_len; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read * cbuf_len I Used by Fortran compiler to pass character length */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= RAW; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry = *lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry = *lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_arc/F77/ACDriver010064400040640000322000000463200624015412200161230ustar00tjpcitmbr00000400000017C*ACDRIV -- PGPLOT device driver for Acorn Archimedes machines C+ SUBROUTINE ACDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MTYPE) INTEGER IFUNC, NBUF, LCHR, MTYPE REAL RBUF(*) CHARACTER*(*) CHR, DEFNAM C C PGPLOT driver for Acorn Archimedes C This driver will cause the system to leave the Desktop, but leave the C screen mode provided it has the normal 16 colours C C This routine must be compiled with Acorn Fortran release 2 C and linked with the Fortran Friends graphics, utils and spriteop libraries. C C 26 January 1996 : Version 1.10 C 16 May 1996 : Version 1.11 allows concurrent /ARCF and ARCV C C Resolution: Depends on graphics mode. Ensure that the current mode is C suitable before running the PGPLOT program. C C version 1.10 also allows the making of the pictures into sprite files C the default sprite size is the screen size but you may alter the C number of pixels in x and y with the variables: C PGPLOT_ARC_WIDTH and PGPLOT_ARC_HEIGHT C the file names will be sprite/01, sprite/02 etc. PARAMETER (DEFNAM = 'sprite/01') C C 26 April 1996 : Version 1.11 (changes to /ARCV) C - small corrections to the initial screen clearing C - allows standard PGPLOT rubber-banded cursors C--- C common for communicating with rubber banding GRARC3 COMMON /GRARCC/ MAXX(2), MAXY(2), I4X0, I4Y0, I4X1, I4Y1, I4MODE INTEGER MAXX, MAXY, I4X0, I4Y0, I4X1, I4Y1, I4MODE C INTEGER NXPIX(2), NYPIX(2), MULTX(2), MULTY(2), IXSTEP(2) SAVE NXPIX, NYPIX, MULTX, MULTY, IXSTEP INTEGER NCOLR, NEEDSP, KOLNOW(2), KOLOUR(0:255) SAVE NCOLR, NEEDSP, KOLNOW, KOLOUR LOGICAL INIT, APPEND, FIRSTO, INPICT(2), STATE(2) SAVE INIT, APPEND, FIRSTO, INPICT, STATE INTEGER IERR, I4X2, I4Y2, MBUF(2), IREGS(0:9), ISCRR(4) LOGICAL SWIERR, SWIF77, SPOP08, SPOP15, LOGDUM CHARACTER ANS*4, INSTR*10, SPNAME*9 DATA INIT/.TRUE./, STATE/2*.FALSE./ DATA KOLOUR/?I00000000, ?IFFFFFF00, ?I0000FF00, ?I00FF0000, 1 ?IFF000000, ?IFFFF0000, ?IFF00FF00, ?I00FFFF00, 2 ?I0080FF00, ?I00FF8000, ?I80FF0000, ?IFF800000, 3 ?IFF008000, ?I8000FF00, ?I50505000, ?IA0A0A000, 4 240*0/ IF(INIT .AND. IFUNC.GT.1) THEN C check for 16-colour mode NCOLR = MODEVAR(-1, 3) IF(NCOLR.EQ.63) NCOLR = 255 IF(NCOLR.EQ.-1) NCOLR = ?IFFFFFF IF(NCOLR.LT.15) THEN CALL GRWARN('Archimedes driver needs at least 16 colours') NBUF = -1 RETURN ENDIF INIT = .FALSE. C get screen characteristics DO 8 MTP = 1, 2 NXPIX(MTP) = MODEVAR(-1, 11) + 1 NYPIX(MTP) = MODEVAR(-1, 12) + 1 IF(MTP.EQ.1) THEN MULTX(1) = MODEVAR(-1, 4) MULTY(1) = MODEVAR(-1, 5) ELSE SPNAME = DEFNAM CALL GRGENV('ARC_WIDTH', INSTR, L) IF(L.GT.0) READ(INSTR, 4)NXPIX(2) 4 FORMAT(BN, I10) CALL GRGENV('ARC_HEIGHT', INSTR, L) IF(L.GT.0) READ(INSTR, 4)NYPIX(2) MULTX(2) = 1 MULTY(2) = 1 ENDIF IXSTEP(MTP) = ISHFT(1, MULTX(MTP)) MAXX(MTP) = ISHFT(NXPIX(MTP), MULTX(MTP)) MAXY(MTP) = ISHFT(NYPIX(MTP), MULTY(MTP)) INPICT(MTP) = .FALSE. 8 CONTINUE ENDIF IF(IFUNC.GT.9 .AND. .NOT.STATE(MTYPE)) THEN CALL GRWARN('Device is not open') NBUF = -1 RETURN ENDIF GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290) IFUNC C unknown driver function, so just return NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 IF(MTYPE.EQ.1) THEN CHR = 'ARCV (screen viewer for Acorn Archimedes machines)' LCHR = LNBLNK(CHR) ELSEIF(MTYPE.EQ.2) THEN CHR = 'ARCF (sprite file for Acorn Archimedes machines)' LCHR = LNBLNK(CHR) ELSE CALL GRWARN('Requested MODE not implemented in Archi driver') LCHR = 0 NBUF = -1 ENDIF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE RBUF(1) = 0 RBUF(2) = MAXX(MTYPE) RBUF(3) = 0 RBUF(4) = MAXY(MTYPE) RBUF(5) = 0 RBUF(6) = MIN(255, NCOLR) NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. C 30 continue RBUF(1) = MAXX(MTYPE)/10.0 RBUF(2) = RBUF(1) RBUF(3) = FLOAT(ISHFT(1, MULTX(MTYPE))) NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, cursor, No dashed lines, No area fill, C No thick lines, rectangle fill) C 40 IF(MTYPE.EQ.1) THEN CHR = 'ICNNNRPVYN' ELSE CHR = 'HNNNNRPNYN' ENDIF LCHR = 10 NBUF = 0 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 IF(MTYPE.EQ.1) THEN CHR = ' ' LCHR = 1 ELSE CHR = SPNAME LCHR = 9 ENDIF RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE RBUF(1) = 0 RBUF(2) = MAXX(MTYPE) RBUF(3) = 0 RBUF(4) = MAXY(MTYPE) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE(MTYPE)) THEN CALL GRWARN('Device is already open') RBUF(2) = 0 ELSE IF(MTYPE.EQ.1) THEN C flag to erase screen on next picture FIRSTO = .TRUE. C set append flag to suppress screen clearing on subsequent pictures APPEND = RBUF(3).NE.0. ENDIF C flag the workstation active STATE(MTYPE) = .TRUE. C but not generating picture yet INPICT(MTYPE) = .FALSE. C RBUF(2) = 1 END IF RBUF(1) = 0 NBUF = 2 RETURN C C--- IFUNC = 10, Close workstation. ------------------------------------ C 100 CONTINUE C flag the workstation inactive STATE(MTYPE) = .FALSE. IF(MTYPE.EQ.1) THEN C reset the 16 colour palette IF(NCOLR.EQ.15) CALL VDU(20) C clear the screen CALL CLS ENDIF RETURN C C--- IFUNC = 11, Begin picture. ---------------------------------------- C 110 CONTINUE IF(MTYPE.EQ.1 .AND. (.NOT.APPEND .OR. FIRSTO)) THEN CALL GRARC2(0, 0, -NCOLR, KOLOUR) C remove viewports and clear screen to background colour CALL VDU(26) CALL CLG C home the text cursor CALL VDU(30) C set foreground text colour IF(NCOLR.EQ.15) CALL COLOUR(1) C remove pointer CALL OSCLI('Pointer 0') ENDIF FIRSTO = .FALSE. IERR=0 IF(MTYPE.EQ.2) THEN C create sprite LBPPIX = MODEVAR(-1, 9) NBYTES = ISHFT(NXPIX(2)*NYPIX(2), LBPPIX)/8 + 64 C first ensure there is space in system sprite area IF(.NOT.SPOP08(0, ISPSIZ, NSPRIT, ISPR1, IFREE)) THEN C case 1, no system sprite area yet NEEDSP = NBYTES + 16 + 44 ELSE C case 2, system sprite area exists C remove any of our sprites which may have been left by accident 112 DO 114 ISPRIT = 1, NSPRIT CALL SPOP13(0, ISPRIT, INSTR,LENG) IF(INSTR(1:7).EQ.'sprite/'.AND.LENG.EQ.9) THEN CALL SPOP25(0, INSTR(1:9)) NSPRIT = NSPRIT -1 GO TO 112 ENDIF 114 CONTINUE LOGDUM = SPOP08(0, ISPSIZ, NSPRIT, ISPR1, IFREE) NEEDSP = NBYTES + 44 - ISPSIZ + IFREE ENDIF IERR = 0 IF(NEEDSP.GT.0) THEN IREGS(0) = 3 IREGS(1) = NEEDSP IF(SWIF77(?I2A, IREGS, IFLAG)) IERR = 100 IF(IERR.EQ.0) THEN IF(IREGS(1).GE.NEEDSP) THEN C successfully assigned memory NEEDSP = IREGS(1) ELSE IERR = 101 ENDIF ENDIF ENDIF C create sprite IF(IERR.EQ.0) THEN IF(NCOLR.EQ.15) THEN C create it with palette in 16 colour mode SWIERR = SPOP15(0, SPNAME, 1, NXPIX(2), NYPIX(2), 27) ELSEIF(NCOLR.EQ.255) THEN SWIERR = SPOP15(0, SPNAME, 0, NXPIX(2), NYPIX(2), 28) ELSE C create sprite 'mode word' (PRM 5-87) MODEW = IOR(?I1680B5, ISHFT(LBPPIX + 1, 27)) SWIERR = SPOP15(0, SPNAME, 0, NXPIX(2), NYPIX(2), MODEW) ENDIF IF(SWIERR) IERR = 103 IF(IERR.EQ.0) CALL GRWARN('creating sprite '//SPNAME) ENDIF IF(IERR.NE.0) THEN CALL GRGMSG(IERR) CALL GRWARN('Failed to allocate plot buffer.') C failed to get enough memory so return it IF(IERR.GT.100) THEN IREGS(1) = -IREGS(1) IF(SWIF77(?I2A, IREGS, IFLAG)) THEN IERR = 101 ELSE IERR = 102 ENDIF ENDIF ENDIF ENDIF C set up colours IF(IERR.EQ.0) THEN IF(NCOLR.EQ.15) THEN DO 118 I = 0, 15 IF(MTYPE.EQ.2) THEN CALL GRARC1(SPNAME, I, KOLOUR(I)) ELSE CALL VDU19(I, 16, 1 IAND(ISHFT(KOLOUR(I), -8), 255), 2 IAND(ISHFT(KOLOUR(I), -16), 255), 3 ISHFT(KOLOUR(I), -24)) ENDIF 118 CONTINUE ELSEIF(MTYPE.EQ.2) THEN C clear 255 colour sprite to background colour CALL SPOP60(0, SPNAME, 0, ISCRR) CALL GRARC2(0, 0, -NCOLR, KOLOUR) CALL CLG CALL NPOP60(ISCRR) ENDIF ENDIF IF(IERR.EQ.0) INPICT(MTYPE) = .TRUE. RETURN C C--- IFUNC = 12, Draw line. -------------------------------------------- C 120 CONTINUE IF(INPICT(MTYPE)) THEN IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR) CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR) CALL LINE(NINT(RBUF(1)), NINT(RBUF(2)), 1 NINT(RBUF(3)), NINT(RBUF(4))) IF(MTYPE.EQ.2) CALL NPOP60(ISCRR) ENDIF RETURN C C--- IFUNC = 13, Draw dot. --------------------------------------------- C 130 CONTINUE IF(INPICT(MTYPE)) THEN IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR) CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR) CALL SPOT(NINT(RBUF(1)), NINT(RBUF(2))) IF(MTYPE.EQ.2) CALL NPOP60(ISCRR) ENDIF RETURN C C--- IFUNC = 14, End picture. ------------------------------------------ C 140 CONTINUE IF(INPICT(MTYPE).AND.MTYPE.EQ.2) THEN C write out sprite CALL SPOP12(0, SPNAME) C delete sprite CALL SPOP25(0, SPNAME) C update sprite name I = ICHAR(SPNAME(9:9)) + 1 IF(I.LT.58) THEN SPNAME(9:9) = CHAR(I) ELSE SPNAME(8:9) = CHAR(ICHAR(SPNAME(8:8)) + 1)//'0' ENDIF C give back memory IF(NEEDSP.GT.0) THEN IREGS(0) = 3 IREGS(1) = -NEEDSP IF(SWIF77(?I2A, IREGS, IFLAG)) THEN CALL GRGMSG(104) CALL GRWARN('Failed to deallocate plot buffer.') ENDIF ENDIF ENDIF INPICT(MTYPE) = .FALSE. RETURN C C--- IFUNC = 15, Select color index. ----------------------------------- 150 CONTINUE KOLNOW(MTYPE) = NINT(RBUF(1)) RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C 170 CONTINUE IF(MTYPE.EQ.2) RETURN C display pointer CALL OSCLI('Pointer') C wait until button(s) and keys are released 172 CALL MOUSE(I4X0, I4Y0, I4B) IF(I4B.NE.0 .OR. INKEY(0).GT.0) GO TO 172 C move to desired place I4X0 = NINT(RBUF(1)) I4Y0 = NINT(RBUF(2)) MBUF(1) = 5 + IOR(ISHFT(I4X0, 8), ISHFT(I4Y0, 24)) MBUF(2) = ISHFT(I4Y0, -8) CALL OSWORD(21, MBUF) C anchor position I4X1 = NINT(RBUF(3)) I4Y1 = NINT(RBUF(4)) C band mode I4MODE = NINT(RBUF(5)) C initial band IF(I4MODE.GT.0) THEN C set colour of banding CALL GRARC2(3, KOLNOW(MTYPE), NCOLR, KOLOUR) CALL GRARC3 ENDIF C loop and wait for keystroke/button click 174 CONTINUE C get mouse pointer status CALL MOUSE(I4X2, I4Y2, I4B) C check for key press KEY = INKEY(0) C 'select' = 'A' IF(I4B.EQ.4) KEY = 65 C 'menu' = 'D' IF(I4B.EQ.2) KEY = 68 C 'adjust' = 'X' IF(I4B.EQ.1) KEY = 88 IF(I4MODE.GT.0) THEN IF(I4X2.NE.I4X0 .OR. I4Y2.NE.I4Y0) THEN C wait for frame scan CALL OSBYTE(19,0,0) C clear the old band CALL GRARC3 C move the band I4X0 = I4X2 I4Y0 = I4Y2 C draw the new band CALL GRARC3 ENDIF ENDIF IF(KEY.LE.0) GO TO 174 C erase final band IF(I4MODE.GT.0) CALL GRARC3 C return current position RBUF(1) = FLOAT(I4X2) RBUF(2) = FLOAT(I4Y2) NBUF = 2 C and character CHR(1:1) = CHAR(KEY) LCHR = 1 RETURN C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C 200 CONTINUE RETURN C C--- IFUNC = 21, Set color representation. ----------------------------- C 210 CONTINUE ICOL = NINT(RBUF(1)) IRED = NINT(RBUF(2)*255.) IGRN = NINT(RBUF(3)*255.) IBLU = NINT(RBUF(4)*255.) KOLOUR(ICOL) = ISHFT(IBLU, 24) + ISHFT(IGRN, 16) + ISHFT(IRED, 8) IF(NCOLR.EQ.15.AND.INPICT(MTYPE)) THEN IF(MTYPE.EQ.2) THEN CALL GRARC1(SPNAME, ICOL, KOLOUR(ICOL)) ELSE CALL VDU19(ICOL, 16, IRED, IGRN, IBLU) ENDIF ENDIF RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC = 23, Escape. ----------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C 240 CONTINUE IF(INPICT(MTYPE)) THEN IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR) CALL GRARC2(0, KOLNOW(MTYPE), NCOLR, KOLOUR) CALL RECTAN(NINT(RBUF(1)), NINT(RBUF(2)), 1 NINT(RBUF(3)), NINT(RBUF(4)), .TRUE.) IF(MTYPE.EQ.2) CALL NPOP60(ISCRR) ENDIF RETURN C C--- IFUNC = 25, Set fill pattern. ------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC = 26, Line of pixels. --------------------------------------- C 260 CONTINUE IF(.NOT.INPICT(MTYPE)) RETURN IF(MTYPE.EQ.2) CALL SPOP60(0, SPNAME, 0, ISCRR) IX = NINT(RBUF(1)) IY = NINT(RBUF(2)) K1 = NINT(RBUF(3)) IX1 = IX DO 264 I = 3 + IXSTEP(MTYPE), NBUF, IXSTEP(MTYPE) K2 = NINT(RBUF(I)) IF(K1.NE.K2) THEN CALL GRARC2(0, K1, NCOLR, KOLOUR) IF(IX.EQ.IX1) THEN CALL SPOT(IX, IY) ELSE CALL LINE(IX1, IY, IX, IY) ENDIF K1 = K2 IX1 = IX + IXSTEP(MTYPE) ENDIF IX = IX + IXSTEP(MTYPE) 264 CONTINUE CALL GRARC2(0, K2, NCOLR, KOLOUR) IF(IX.EQ.IX1) THEN CALL SPOT(IX, IY) ELSE CALL LINE(IX1, IY, IX, IY) ENDIF IF(MTYPE.EQ.2) CALL NPOP60(ISCRR) RETURN C C--- IFUNC = 27, Not implemented --------------------------------------- C 270 CONTINUE RETURN C C--- IFUNC = 28, Not implemented --------------------------------------- C 280 CONTINUE RETURN C C--- IFUNC = 29, Query color representation. --------------------------- C 290 CONTINUE I = RBUF(1) RBUF(2) = IAND(ISHFT(KOLOUR(I), -8), 255)/255.0 RBUF(3) = IAND(ISHFT(KOLOUR(I), -16), 255)/255.0 RBUF(4) = IAND(ISHFT(KOLOUR(I), -24), 255)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END C SUBROUTINE GRARC1(SPNAME, I, KOL) DIMENSION IREGS(0:9) CHARACTER *(*) SPNAME, NAME*12 EQUIVALENCE(IPP, IREGS(4)) LOGICAL SWIF77 C set sprite palette I to KOL (Only in RISC-OS 3) NAME = SPNAME L = LNBLNK(NAME) NAME(L+1:L+1) = CHAR(0) IREGS(0) = 37 IREGS(1) = 0 IREGS(2) = LOCC(NAME) IREGS(3) = -1 C do SpriteOp 37 IF(SWIF77(?I2E, IREGS, IFLAG))RETURN IF(IPP.EQ.0) RETURN IOFF = (IPP - LOC(IREGS))/4 C address of palette is now IREGS(IOFF) KK = IOR(16, IAND(KOL, ?IFFFFFF00)) IREGS(IOFF+I+I) = KK IREGS(IOFF+I+I+1) = KK RETURN END C SUBROUTINE GRARC2(IACT, KOLNOW, NCOLR, KOLOUR) C set up currrent graphics colour and action DIMENSION IREGS(0:9), KOLOUR(0:255) IF(IABS(NCOLR).EQ.15) THEN IF(NCOLR.GT.0) THEN CALL GCOL(IACT, KOLNOW) ELSE CALL GCOL(IACT, KOLNOW + 128) ENDIF ELSE IREGS(0) = KOLOUR(KOLNOW) IREGS(3) = 0 IF(NCOLR.LT.0) IREGS(3)=128 IREGS(4) = IACT C do ColourTrans_SetGCOL CALL SWIF77(?I040743, IREGS, IFLAG) ENDIF RETURN END C SUBROUTINE GRARC3 C common for communicating with rubber banding GRARC3 COMMON /GRARCC/ MAXX(2), MAXY(2), I4X0, I4Y0, I4X1, I4Y1, I4MODE INTEGER MAXX, MAXY, I4X0, I4Y0, I4X1, I4Y1, I4MODE C only used for MTYPE=1, i.e. MAXX(1) and MAXY(1) C C draw band of type I4MODE from (I4X1,I4Y1) to (I4X0,I4Y0) C I4MODE = 1: ordinary rubber band C 2: rectangular box C 3: horizontal lines C 4: vertical lines C 5: horizontal line through (I4X0,I4Y0) only C 6: vertical line through (I4X0,I4Y0) only C 7: vertical and horizontal lines through (I4X0,I4Y0) only C GO TO (10, 20, 30, 40, 32, 42, 70), I4MODE RETURN C ordinary rubber band 10 CALL LINE(I4X1, I4Y1, I4X0, I4Y0) RETURN C rectangular box 20 CALL RECTAN(I4X1, I4Y1, I4X0, I4Y0, .FALSE.) RETURN C horizontal lines 30 CALL LINE(0, I4Y1, MAXX, I4Y1) 32 CALL LINE(0, I4Y0, MAXX, I4Y0) RETURN C vertical lines 40 CALL LINE(I4X1, 0, I4X1, MAXY) 42 CALL LINE(I4X0, 0, I4X0, MAXY) RETURN C vertical and horizontal lines through (I4X0,I4Y0) only 70 CALL LINE(0, I4Y0, MAXX, I4Y0) GO TO 42 END 'Failed to allocate plot buffer.') C failed to get enough memory so return it IF(IERR.GT.100) THEN IREGS(1) = -IREGS(1) IF(SWIF77(?I2A, IREGS, IFLAG)) THEN IERR = 101 ELSE IERR = 102 ENDIF ENDIFpgplot/sys_arc/F77/ARCInclude010064400040640000322000000006770624015417200164070ustar00tjpcitmbr00000400000017C code added in to the main source to make the PGPlot library INCLUDE 'SYS_ARC.f77.GRArchi' C add graphics drivers INCLUDE 'SYS_ARC.f77.GRexecAC' INCLUDE 'SYS_ARC.f77.ACDriver' INCLUDE 'SYS_ARC.f77.NUDriver' INCLUDE 'SYS_ARC.f77.PSDriver' C add GRsyxd without INTEGER*2 INCLUDE 'SYS_ARC.f77.GRsyxd' C add GRTRIM which does not fall over compiler bug INCLUDE 'SYS_ARC.f77.GRtrim' pgplot/sys_arc/F77/ConvertHlp010064400040640000322000000024540614117263100165550ustar00tjpcitmbr00000400000017 PROGRAM MHELP C to make an !SrcEdit type help file CHARACTER LINE*80, TEST*80 LOGICAL NOGR 10 PRINT 101 101 FORMAT(' Exclude GRxxxx routines? (Y/N) ',$) READ(*,102,ERR=10)TEST 102 FORMAT(A) IF(TEST.EQ.'Y'.OR.TEST.EQ.'y') THEN NOGR=.TRUE. ELSEIF(TEST.EQ.'N'.OR.TEST.EQ.'n') THEN NOGR=.FALSE. ELSE GO TO 10 ENDIF OPEN(10,FILE='.f77.PGPlot',STATUS='OLD',ERR=90) OPEN(11,FILE='.HelpPGPLOT',STATUS='UNKNOWN') 20 READ(10,102,END=80)LINE IF(LINE(1:2).NE.'C*') GO TO 20 30 IF(LINE(3:4).EQ.'GR'.AND.NOGR) GO TO 20 40 READ(10,102,END=80)TEST IF(TEST(1:2).EQ.'C*') THEN LINE=TEST GO TO 30 ENDIF IF(TEST(1:2).NE.'C+') GO TO 40 L=LNBLNK(LINE) I=INDEX(LINE,' ') WRITE(11,102)'%'//LINE(3:I-1) PRINT 102,LINE(3:I-1) I=INDEX(LINE(I+1:),' ')+I WRITE(11,102)LINE(I:L) 50 READ(10,102,END=80)LINE IF(LINE(1:3).EQ.'C--') THEN WRITE(11,*) GO TO 20 ELSE L=MAX(2,LNBLNK(LINE)) WRITE(11,102)LINE(2:L) ENDIF GO TO 50 80 CLOSE(10) CLOSE(11) CALL OSCLI('SetType .HelpPGPLOT FFF') STOP 90 STOP 'Can not find PGPLOT source in f77 directory' END pgplot/sys_arc/F77/GRARchi010064400040640000322000000323400614117261700157110ustar00tjpcitmbr00000400000017C Acorn Archimedes specific code C 17 February 1994 version 1.00 C C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C----------------------------------------------------------------------- CHARACTER*(*) ARCHI PARAMETER (ARCHI='') INTEGER BUFFER(13500) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=ARCHI, FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) CALL GRWARN('Unable to read font file: '//ARCHI) RETURN END C*GRDATE -- get date and time as character string Archimedes C+ SUBROUTINE GRDATE(CDATE, LDATE) CHARACTER CDATE*(*), TEMP*18, FORM*22 INTEGER LDATE,IREGS(0:7),ITIME(2) DATA FORM(1:21)/'%DY-%M3-19%YR %24:%MI'/FORM(22:22)/?H00/ C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the CDATE should be declared C CHARACTER*17. C C Arguments: C CDATE : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 1989-Mar-17 - [AFT] C----------------------------------------------------------------------- ITIME(1) = 3 CALL OSWORD(14,ITIME) IREGS(0)=LOC(ITIME) IREGS(1)=LOCC(TEMP) IREGS(2)=18 IREGS(3)=LOCC(FORM) CALL SWIF77(?IC1,IREGS,IFLAG) CDATE=TEMP(1:17) LDATE=17 RETURN END C*GRFLUN -- free a Fortran logical unit number C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. [This version C is pretty stupid; GRGLUN allocates units starting at 81, and GRFLUN C does not free units.] C C Arguments: C LUN : the logical unit number to free. C-- C 25-Nov-1988 C----------------------------------------------------------------------- RETURN END C*GRGCOM -- read with prompt from user's terminal C+ INTEGER FUNCTION GRGCOM(CREAD, CPROM, LREAD) CHARACTER CREAD*(*), CPROM*(*) INTEGER LREAD C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C CREAD : (output) receives the string read from the terminal. C CPROM : (input) prompt string. C LREAD : (output) length of CREAD. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 1989-Mar-29 C----------------------------------------------------------------------- INTEGER IER C--- 11 FORMAT(A) C--- GRGCOM = 0 LREAD = 0 WRITE (*, 101, IOSTAT=IER) CPROM 101 FORMAT(1X,A,' ',$) IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CREAD IF (IER.EQ.0) GRGCOM = 1 LREAD = LNBLNK(CREAD) RETURN END C********* C*GRMSG -- issue message to user C+ SUBROUTINE GRMSG (TEXT) CHARACTER*(*) TEXT C C Display a message on standard error. C C Argument: C TEXT (input): text of message to be printed (the string C may not be blank). C-- C 1991-Jul-27 - From SUN version [AFT] C----------------------------------------------------------------------- INTEGER I C I = LNBLNK(TEXT) IF(I.GT.0) WRITE (*, '(1X,A)') TEXT(1:I) END C*GRGENV -- get value of PGPLOT environment parameter C+ SUBROUTINE GRGENV(CNAME, CVALUE, LVALUE) CHARACTER CNAME*(*), CVALUE*(*) INTEGER LVALUE C C Return the value of a PGPLOT environment parameter. C C Arguments: C CNAME : (input) the name of the parameter to evaluate. C CVALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C LVALUE : receives the number of characters in CVALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 1990-Mar-19 - [AFT] C----------------------------------------------------------------------- C CHARACTER*64 CTIN,CTOUT INTEGER I, LTMP,IREGS(0:7) LOGICAL SWIF77 C CTIN = 'PGPLOT_'//CNAME LTMP = INDEX(CTIN,' ') IF(LTMP.EQ.0) LTMP=LEN(CTIN)-1 CTIN(LTMP:LTMP)=CHAR(0) IREGS(0)=LOCC(CTIN) IREGS(1)=LOCC(CTOUT) IREGS(2)=64 IREGS(3)=0 IREGS(4)=0 IF(SWIF77(?I23,IREGS,IFLAG)) THEN LVALUE = 0 ELSE LVALUE = IREGS(2) CVALUE = CTOUT(1:LVALUE) ENDIF RETURN END C*GRGLUN -- get a Fortran logical unit number C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Get an unused Fortran logical unit number. C Returns a Logical Unit Number that is not currently opened. C After GRGLUN is called, the unit should be opened to reserve C the unit number for future calls. Once a unit is closed, it C becomes free and another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 C as older software will often use these units without warning. C C Arguments: C LUN : receives the logical unit number, or -1 on error. C-- C 12-Feb-1989 [AFT/TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL QOPEN C--- DO 10 I=10,60 INQUIRE (UNIT=I, OPENED=QOPEN) IF (.NOT.QOPEN) THEN LUN = I RETURN ENDIF 10 CONTINUE CALL GRWARN('GRGLUN: out of units.') LUN = -1 RETURN END C*GRGMSG -- print system message C+ SUBROUTINE GRGMSG (ISTAT) INTEGER ISTAT C C This routine obtains the text of the VMS system message corresponding C to code ISTAT, and displays it using routine GRWARN. On non-VMS C systems, it just displays the error number. C C Argument: C ISTAT (input): 32-bit system message code. C-- C 1989-Mar-29 C----------------------------------------------------------------------- CHARACTER CBUF*10 C WRITE (CBUF, 101) ISTAT 101 FORMAT(I10) CALL GRWARN('system message number: '//CBUF) END C*GRLGTR -- translate logical name C+ SUBROUTINE GRLGTR (CNAME) CHARACTER CNAME*(*) C C Recursive translation of a logical name. C Up to 20 levels of equivalencing can be handled. C This is used in the parsing of device specifications in the C VMS implementation of PGPLOT. In other implementations, it may C be replaced by a null routine. C C Argument: C CNAME (input/output): initially contains the name to be C inspected. If an equivalence is found it will be replaced C with the new name. If not, the old name will be left there. The C escape sequence at the beginning of process-permanent file C names is deleted and the '_' character at the beginning of C device names is left in place. C-- C 18-Feb-1988 C----------------------------------------------------------------------- RETURN END C*GROPTX -- open output text file C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM) INTEGER UNIT CHARACTER*(*) NAME, DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER OPEN (UNIT=UNIT, FILE=NAME, 2 STATUS='UNKNOWN', 2 IOSTAT=IER) GROPTX = IER C----------------------------------------------------------------------- RETURN END C*GRPROM -- prompt user before clearing screen C+ SUBROUTINE GRPROM C C Display "Type for next page: " and wait for the user to C type before proceeding. C C Arguments: C none C-- C 1989-Mar-29 C----------------------------------------------------------------------- INTEGER IER CHARACTER CMESS*14 C--- 11 FORMAT(A) C--- WRITE(*,101,IOSTAT=IER) CHAR(7)//'Type for next page: ' 101 FORMAT(1X,A,$) IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CMESS RETURN END C*GRQUIT -- report a fatal error and abort execution C+ SUBROUTINE GRQUIT (CTEXT) CHARACTER CTEXT*(*) C C Report a fatal error (via GRWARN) and exit with fatal status; a C traceback is generated unless the program is linked /NOTRACE. C C Argument: C CTEXT (input): text of message to be sent to GRWARN. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CALL GRWARN(CTEXT) STOP 'Fatal error in PGPLOT library' END C*GRTRML -- get name of user's terminal C+ SUBROUTINE GRTRML(CTERM, LTERM) CHARACTER CTERM*(*) INTEGER LTERM C C Return the device name of the user's terminal, if any. C C Arguments: C CTERM : receives the terminal name, truncated or extended with C blanks as necessary. C LTERM : receives the number of characters in CTERM, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 1989-Nov-08 C----------------------------------------------------------------------- CTERM = 'Archimedes' LTERM = 10 RETURN END C*GRTTER -- test whether device is user's terminal C+ SUBROUTINE GRTTER(CDEV, QSAME) CHARACTER CDEV*(*) LOGICAL QSAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C CDEV : (input) the device name to be tested. C QSAME : (output) .TRUE. is CDEV contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CTERM*64 INTEGER LTERM C CALL GRTRML(CTERM, LTERM) QSAME = (CDEV.EQ.CTERM(:LTERM)) END C*GRUSER -- get user name C+ SUBROUTINE GRUSER(CUSER, LUSER) CHARACTER CUSER*(*) INTEGER LUSER C C Return the name of the user running the program. C C Arguments: C CUSER : receives user name, truncated or extended with C blanks as necessary. C LUSER : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 1989-Mar-19 - [AFT] C----------------------------------------------------------------------- C CALL GRGENV('USER', CUSER, LUSER) RETURN END C*GRWARN -- issue warning message to user C+ SUBROUTINE GRWARN (CTEXT) CHARACTER CTEXT*(*) C C Report a warning message on standard error, with prefix "%PGPLOT, ". C It is assumed that Fortran unit 0 is attached to stderr. C C Argument: C CTEXT (input): text of message to be printed (the string C may not be blank). C-- C 18-Feb-1988 C----------------------------------------------------------------------- INTEGER I C I = LNBLNK(CTEXT) IF(I.GT.0) WRITE (*,*) ' %PGPLOT, ',CTEXT(1:I) RETURN END pgplot/sys_arc/F77/GRexecAC010064400040640000322000000022550615365226700160640ustar00tjpcitmbr00000400000017C*GREXEC -- PGPLOT device handler dispatch routine C+ SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IDEV, IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C--- INTEGER NDEV C change the value of NDEV to reflect the number of C devices defined below by the 'computed GOTO' C C February 1994 Version 1.00 has only NU, AC and PS drivers. C (The PS driver comes with 4 modes) C PARAMETER (NDEV=7) CHARACTER*10 MSG C--- GOTO(1,2,3,4,5,6,7) IDEV IF (IDEV.EQ.0) THEN RBUF(1) = NDEV NBUF = 1 ELSE WRITE (MSG,'(I10)') IDEV CALL GRQUIT('Unknown device code in GREXEC: '//MSG) END IF RETURN C--- 1 CALL NUDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN 2 CALL ACDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) RETURN 3 CALL ACDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) RETURN 4 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) RETURN 5 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) RETURN 6 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,3) RETURN 7 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,4) RETURN C END pgplot/sys_arc/F77/GRsyxd010064400040640000322000000070270614117257200157160ustar00tjpcitmbr00000400000017C*GRSYXD -- obtain the polyline representation of a given symbol C+ SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED) INTEGER SYMBOL INTEGER XYGRID(300) LOGICAL UNUSED C C February 1994: INTEGER*2 removed to allow compilation on the Acorn C Archimedes compiler where this is not allowed. C Here an INTEGER FUNCTION BUFFER(INDEX) unpacks the C 16-bit word from the INTEGER*4 array BUFFPK(13500) C rather than the INTEGER*2 BUFFER(27000) of C the original code. C D.J. Crennell (Fortran Friends) C C Return the digitization coordinates of a character. Each character is C defined on a grid with X and Y coordinates in the range (-49,49), C with the origin (0,0) at the center of the character. The coordinate C system is right-handed, with X positive to the right, and Y positive C upward. C C Arguments: C SYMBOL (input) : symbol number in range (1..3000). C XYGRID (output) : height range, width range, and pairs of (x,y) C coordinates returned. Height range = (XYGRID(1), C XYGRID(3)). Width range = (XYGRID(4),XYGRID(5)). C (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...). C UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol C number. A character of normal height and zero width C is returned. Receives .FALSE. if SYMBOL is a C valid symbol number. C C The height range consists of 3 values: (minimum Y, baseline Y, C maximum Y). The first is reached by descenders on lower-case g, p, C q, and y. The second is the bottom of upper-case letters. The third C is the top of upper-case letters. A coordinate pair (-64,0) requests C a pen raise, and a pair (-64,-64) terminates the coordinate list. It C is assumed that movement to the first coordinate position will be C done with the pen raised - no raise command is explicitly included to C do this. C-- C 7-Mar-1983. C 15-Dec-1988 - standardize. C----------------------------------------------------------------------- INTEGER BUFFPK(13500),BUFFER INTEGER INDEX(3000), IX, IY, K, L, LOCBUF INTEGER NC1, NC2 COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFPK C C Extract digitization. C IF (SYMBOL.LT.NC1 .OR. SYMBOL.GT.NC2) GOTO 3000 L = SYMBOL - NC1 + 1 LOCBUF = INDEX(L) IF (LOCBUF .EQ. 0) GOTO 3000 XYGRID(1) = BUFFER(LOCBUF) LOCBUF = LOCBUF + 1 K = 2 IY = -1 C -- DO WHILE (IY.NE.-64) 100 IF (IY.NE.-64) THEN IX = BUFFER(LOCBUF)/128 IY = BUFFER(LOCBUF) - 128*IX - 64 XYGRID(K) = IX - 64 XYGRID(K+1) = IY K = K + 2 LOCBUF = LOCBUF + 1 GOTO 100 END IF C -- end DO WHILE UNUSED = .FALSE. RETURN C C Unimplemented character. C 3000 XYGRID(1) = -16 XYGRID(2) = -9 XYGRID(3) = +12 XYGRID(4) = 0 XYGRID(5) = 0 XYGRID(6) = -64 XYGRID(7) = -64 UNUSED = .TRUE. RETURN END C INTEGER FUNCTION BUFFER(K) INTEGER BUFFPK(13500), INDEX(3000) COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFPK LOGICAL BTEST C unpack buffer as INTEGER*2 from BUFFPK K1 = ISHFT(K+1,-1) IF(K1+K1 .EQ. K) THEN BUFFER = ISHFT(BUFFPK(K1),-16) ELSE BUFFER = IAND(BUFFPK(K1),65535) ENDIF C correct for negative word IF(BTEST(BUFFER,15)) BUFFER = IOR(BUFFER, ?IFFFF0000) RETURN END pgplot/sys_arc/F77/GRtrim010064400040640000322000000020010614117255000156610ustar00tjpcitmbr00000400000017C*GRTRIM -- length of string excluding trailing blanks C+ INTEGER FUNCTION GRTRIM(S) CHARACTER*(*) S C C Find the length of a character string excluding trailing blanks. C A blank string returns a value of 0. C C Argument: C S (input) : character string. C C Returns: C GRTRIM : number of characters in S, excluding trailing C blanks, in range 0...LEN(S). A blank string C returns a value of 0. C C Subroutines required: C None C C Fortran 77 extensions: C None C C History: C 1987 Nov 12 - TJP. C----------------------------------------------------------------------- INTEGER I C C next card falls over bug 8 in Fortran so invert it! C D.J. Crennell 27 April 1996 C IF (S.EQ.' ') THEN IF (' '.EQ.S) THEN GRTRIM = 0 ELSE DO 10 I=LEN(S),1,-1 GRTRIM = I IF (S(I:I).NE.' ') GOTO 20 10 CONTINUE GRTRIM = 0 20 CONTINUE END IF END pgplot/sys_arc/F77/NUDriver010064400040640000322000000263020614117253400161670ustar00tjpcitmbr00000400000017C*NUDRIV -- PGPLOT Null device driver C+ SUBROUTINE NUDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Null device (no graphical output) C C Version 1.0 - 1987 May 26 - T. J. Pearson. C Version 1.1 - 1988 Mar 23 - add rectangle fill. C Version 1.2 - 1992 Sep 3 - add line-of-pixels. C Version 1.3 - 1992 Sep 21 - add markers. C Version 1.4 - 1993 Apr 22 - add optional debugging. C Version 1.5 - 1994 Aug 31 - use image primitives. C Version 2.0 - 1996 Jan 22 - allow multiple active devices; C add QCR primitive. C C Supported device: The ``null'' device can be used to suppress C all graphic output from a program. If environment variable C PGPLOT_DEBUG is defined, some debugging information is C reported on standard output. C C Device type code: /NULL. C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Undefined (The device pretends to C be a hardcopy device with 1000 pixels/inch and a view surface 8in C high by 10.5in wide.) C C Resolution: Undefined. C C Color capability: Color indices 0--255 are accepted. C C Input capability: None. C C File format: None. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- C Notes: C Up to MAXDEV "devices" may be open at once. ACTIVE is the number C of the currently selected device, or 0 if no devices are open. C STATE(i) is 0 if device i is not open, 1 if it is open but with C no current picture, or 2 if it is open with a current picture. C C When debugging is enabled, open/close device and begin/end picture C calls are reported on stdout, and a cumulative count of all C driver calls is kept. C----------------------------------------------------------------------- CHARACTER*(*) DEVICE PARAMETER (DEVICE='NULL (Null device, no output)') INTEGER MAXDEV PARAMETER (MAXDEV=8) INTEGER NOPCOD PARAMETER (NOPCOD=29) CHARACTER*10 MSG CHARACTER*32 TEXT CHARACTER*8 LAB(NOPCOD) INTEGER COUNT(NOPCOD), I, STATE(0:MAXDEV), L, NPIC(MAXDEV) INTEGER ACTIVE LOGICAL DEBUG INTEGER CTABLE(3,0:255), CDEFLT(3,0:15) SAVE COUNT, STATE, NPIC, DEBUG, CTABLE, CDEFLT, ACTIVE C DATA ACTIVE/-1/ DATA COUNT/NOPCOD*0/ DATA DEBUG/.FALSE./ DATA LAB /'qdev ', 'qmaxsize', 'qscale ', 'qcapab ', 1 'qdefnam ', 'qdefsize', 'qmisc ', 'select ', 2 'open ', 'close ', 'beginpic', 'line ', 3 'dot ', 'endpic ', 'set CI ', 'flush ', 4 'cursor ', 'eralpha ', 'set LS ', 'polygon ', 5 'set CR ', 'set LW ', 'escape ', 'rectangl', 6 'set patt', 'pix/imag', 'scaling ', 'marker ', 7 'query CR'/ DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ C----------------------------------------------------------------------- C IF (ACTIVE.EQ.-1) THEN CALL GRGENV('DEBUG', TEXT, L) DEBUG = L.GT.0 ACTIVE = 0 STATE(ACTIVE) = 0 END IF C IF (IFUNC.LT.1 .OR. IFUNC.GT.NOPCOD) GOTO 900 COUNT(IFUNC) = COUNT(IFUNC) + 1 GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290), IFUNC 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in NULL device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = DEVICE LCHR = LEN(DEVICE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 65535 RBUF(3) = 0 RBUF(4) = 65535 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1000.0 RBUF(2) = 1000.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, Dashed lines, Area fill, Thick C lines, Rectangle fill, Images, , , Markers, query color rep) C 40 CHR = 'HNDATRQNYM' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = 'NL:' LCHR = 3 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 10499 RBUF(3) = 0 RBUF(4) = 7999 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE I = RBUF(2) - 67890 IF (I.LT.1 .OR. I.GT.MAXDEV) THEN CALL GRWARN('internal error: NULL opcode 8') ELSE IF (STATE(I).GT.0) THEN ACTIVE = I ELSE CALL GRNU00(IFUNC,0) END IF RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- Find an inactive device, and select it DO 91 I=1,MAXDEV IF (STATE(I).EQ.0) THEN ACTIVE = I STATE(ACTIVE) = 1 GOTO 92 END IF 91 CONTINUE IF (DEBUG) CALL GRWARN ('09 Open workstation') CALL GRWARN('maximum number of devices of type NULL exceeded') RBUF(1) = 0 RBUF(2) = 0 NBUF = 2 RETURN C -- Initialize the new device 92 CONTINUE RBUF(1) = ACTIVE + 67890 RBUF(2) = 1 NBUF = 2 NPIC(ACTIVE) = 0 C -- Initialize color table DO 95 I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) 95 CONTINUE DO 96 I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 96 CONTINUE IF (DEBUG) THEN CALL GRFAO('09 Open workstation: device #', : L, TEXT, ACTIVE, 0, 0, 0) CALL GRWARN(TEXT(1:L)) END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 0 IF (DEBUG) THEN CALL GRFAO('10 Close workstation: device #', : L, TEXT, ACTIVE, 0, 0, 0) CALL GRWARN(TEXT(1:L)) CALL GRWARN('Device driver calls:') DO 101 I=1,NOPCOD IF (COUNT(I).GT.0) THEN WRITE (TEXT,'(3X,I2,1X,A8,I10)') I, LAB(I), COUNT(I) CALL GRWARN(TEXT) END IF 101 CONTINUE END IF RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 2 NPIC(ACTIVE) = NPIC(ACTIVE)+1 IF (DEBUG) THEN CALL GRFAO('11 Begin picture # on device #', : L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0) CALL GRWARN(TEXT(:L)) END IF RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 1 IF (DEBUG) THEN CALL GRFAO('14 End picture # on device #', : L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0) CALL GRWARN(TEXT(:L)) END IF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) I = RBUF(1) CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE IF (DEBUG.AND.STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=25, Not implemented ----------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=27, Scaling info -- ----------------------------------------- C 270 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=28, Draw marker --------------------------------------------- C 280 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) C WRITE (*,'(1X,A,I4,1X,3F10.1)') 'MARKER', NINT(RBUF(1)), RBUF(2), C 1 RBUF(3), RBUF(4) RETURN C C--- IFUNC=29, Query color representation. ----------------------------- C 290 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END SUBROUTINE GRNU00(IFUNC, STATE) INTEGER IFUNC, STATE C C PGPLOT NULL device driver: report error C----------------------------------------------------------------------- INTEGER L CHARACTER*80 MSG C CALL GRFAO('++ internal error: driver in state # for opcode #', : L, MSG, STATE, IFUNC, 0, 0) CALL GRWARN(MSG(1:L)) RETURN END pgplot/sys_arc/F77/PGPack010064400040640000322000000111200614117252200155630ustar00tjpcitmbr00000400000017 PROGRAM PACK C----------------------------------------------------------------------- C C February 1994 Converted to INTEGER*4 because the Acorn Archimedes C complier does not support INTEGER*2. The resultant C file format is the same as if INTEGER*2 were supported. C C Input file name changed to: .grfont/txt C Output file name changed to: C C These names circumvent the 30 character limit in C Archimedes Fortran. C D.J. Crennell (Fortran Friends) C C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000,MAXPK=MAXBUF/2) C INTEGER INDEX(MAXCHR) INTEGER BUFPK(MAXPK) INTEGER I, LENGTH, LOC, NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open input file. C OPEN (UNIT=1, STATUS='OLD', FILE='.grfont/txt') C C Read input file. C 10 CONTINUE C -- read next character READ (1,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (1,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC C pack as integer*2 LC = ISHFT(LOC+1,-1) C*** new INTEGER*4 instructions follow: IF(LC+LC.EQ.LOC) THEN BUFPK(LC) = IOR(BUFPK(LC),ISHFT(XYGRID(1),16)) ELSE BUFPK(LC) = IAND(XYGRID(1),65535) ENDIF C *** old INTEGER*2 instruction BUFFER(LOC) = XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 C pack as integer*2 IIPK = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 LC = ISHFT(LOC+1,-1) C*** new INTEGER*4 instructions follow: IF(LC+LC.EQ.LOC) THEN BUFPK(LC) = IOR(BUFPK(LC),ISHFT(IIPK,16)) ELSE BUFPK(LC) = IAND(IIPK,65535) ENDIF C *** old INTEGER*2: BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE CLOSE (UNIT=1) C C Write output file. C OPEN (UNIT=2, STATUS='NEW', FORM='UNFORMATTED', + FILE='') NC1 = 1 NC2 = 3000 WRITE (2) NC1,NC2,LOC,INDEX,BUFPK CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/sys_arc/F77/PGUnpack010064400040640000322000000033330614117250500161360ustar00tjpcitmbr00000400000017 PROGRAM UNPACK C---------------------------------------------------------------------- C C February 1994 Output file name changed for Acorn Archimedes C environment. C D.J. Crennell (Fortran Friends) C C Convert packed (binary) representation of GRFONT into unpacked C (ASCII) representation suitable for editing. The input file is C read from PLT$FONT as in PGPLOT; the output file is GRFONT.TXT. C C This program uses the PGPLOT internal routines GRSY00 and C GRSYXD and must therefore be linked with the non-shareable library. C C T. J. Pearson 1987 May 6 C---------------------------------------------------------------------- INTEGER XYGRID(300) LOGICAL UNUSED INTEGER I, N, LENGTH C----------------------------------------------------------------------- OPEN (UNIT=1, FILE='.GRFont/txt', STATUS='NEW', 1 FORM = 'FORMATTED') CALL GRSY00 DO 30 N=1,4000 CALL GRSYXD(N,XYGRID,UNUSED) IF (.NOT.UNUSED) THEN c DO 10 I=1,300 DO 10 I=2,300,2 IF(XYGRID(I).EQ.-64) THEN IF (XYGRID(I+1).EQ.-64) THEN LENGTH = I+1 GOTO 20 END IF END IF 10 CONTINUE STOP 'Unfortunate error' 20 WRITE (1,'(7(2X,2I4))') N, LENGTH, (XYGRID(I), I=1,5) WRITE (1,'(7(2X,2I4))') (XYGRID(I),I=6,LENGTH) PRINT *,'entry',N END IF 30 CONTINUE CLOSE(1) CALL OSCLI('SetType '//'.fonts.grfont/txt FFF') C----------------------------------------------------------------------- END pgplot/sys_arc/F77/PSDriver010064400040640000322000001067410624015425700161770ustar00tjpcitmbr00000400000017C*PSDRIV -- PGPLOT PostScript drivers C+ SUBROUTINE PSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for PostScript devices. C C Version 1.2 - 1987 Aug 5 - T. J. Pearson. C Version 1.3 - 1987 Nov 16 - add "bind" commands to prolog - TJP. C Version 1.4 - 1988 Jan 28 - change dimensions so whole field can be C plotted - TJP. C Version 1.5 - 1988 Oct 27 - make EOF characters optional - TJP. C Version 1.6 - 1988 Dec 15 - standard Fortran - TJP. C Version 1.7 - 1989 Jul 5 - change color indices so most colors C are black - TJP. C Version 2.0 - 1990 Sep 10 - parameterize dimensions; correct C bounding box; add color support (from C D. Meier's CPdriver) - TJP. C Version 2.1 - 1991 Nov 29 - update Document Structuring Conventions C to version 3.0. C Version 3.0 - 1992 Sep 22 - add marker support; add CPS and VCPS C modes - TJP. C Version 3.1 - 1992 Nov 12 - up to 256 colors. C Version 3.2 - 1993 May 26 - correct error in marker support. C Version 4.0 - 1993 Sep 20 - trap Fortran I/O errors. C Version 4.1 - 1994 Aug 4 - make marker support optional. C Version 5.0 - 1994 Aug 30 - support for images. C Version 5.1 - 1994 Sep 7 - support for PGQCR. C Version 5.2 - 1994 Oct 12 - add IDENT option. C Version 5.3 - 1995 May 8 - recognise '-' as standard output; keep C track of bounding box; use upper case C for all defined commands; move C showpage outside save/restore. C Version 5.4 - 1995 Aug 19 - correct usage of PS_BBOX. C Version 6.0 - 1995 Dec 28 - reject concurrent access. C Version 6.1 - 1996 Apr 29 - decode environment variables using GRCTOI. C Version 6.2 - 1996 Oct 7 - correct bounding-box error (K-G Adams); C correct error in use of GCTOI (G Gonczi); C suppress <0 0 C> commands (R Scharroo); C allow arbitrary page size. C - 1996 Nov 5 - sets postscript file type for Acorn (D.J.C) C C Supported device: C Any printer that accepts the PostScript page description language, C eg, the LaserWriter (Apple Computer, Inc.). C PostScript is a trademark of Adobe Systems Incorporated. C C Device type code: C /PS (monochrome landscape mode, long edge of paper horizontal). C /CPS (color landscape mode, long edge of paper horizontal). C /VPS (monochrome portrait mode, short edge of paper horizontal). C /VCPS (color portrait mode, short edge of paper horizontal). C C Default file name: C pgplot.ps C C Default view surface dimensions: C 10.5 inches horizontal x 7.8 inches vertical (landscape mode), C 7.8 inches horizontal x 10.5 inches vertical (portrait mode). C These dimensions can be changed with environment variables. C C Resolution: C The driver uses coordinate increments of 0.001 inch, giving an C ``apparent'' resolution of 1000 pixels/inch. The true resolution is C device-dependent; eg, on an Apple LaserWriter it is 300 pixels/inch C (in both dimensions). C C Color capability (monochrome mode): C Color indices 0-255 are supported. Color index 0 is white (erase C or background color), indices 1-13 are black, 14 is light grey, C and 15 is dark grey. C C Color capability (color mode): C Color indices 0-255 are supported. Color index 0 is white (erase C or background color), index 1 is black, and indices 2-15 have the C standard PGPLOT color assignments. C C Input capability: none. C C File format: the file contains variable length records (maximum 132 C characters) containing PostScript commands. The commands use only C printable ASCII characters, and the file can be examined or modified C with a text editor. C C Obtaining hardcopy: use the operating system print or copy command to C send the file to a suitable device. C C Environment variables: C C PGPLOT_PS_WIDTH default 7800 C PGPLOT_PS_HEIGHT default 10500 C PGPLOT_PS_HOFFSET default 350 C PGPLOT_PS_VOFFSET default 250 C These variables tell PGPLOT how big an image to produce. The defaults C are appropriate for 8.5 x 11-inch paper. The maximum dimensions of C a PGPLOT image are WIDTH by HEIGHT, with the lower left corner offset C by HOFFSET horizontally and VOFFSET vertically from the lower left C corner of the paper. The units are milli-inches. The "top" of the C paper is the edge that comes out of the printer first. C C PGPLOT_IDENT C If this variable is set, the user name, date and time are written C in the bottom right corner of each page. C C PGPLOT_PS_BBOX C If this variable has value MAX, PGPLOT puts standard (full-page) C bounding-box information in the header of the PostScript file. If C the variable is unset or has some other value, PGPLOT puts the C correct (smallest) bounding box information in the trailer of the C PostScript file. C C PGPLOT_PS_EOF C Normally the output file does not contain special end-of-file C characters. But if environment variable PGPLOT_PS_EOF is defined C (with any value) PGPLOT writes a control-D job-separator character at C the beginning and at the end of the file. This is appropriate for C Apple LaserWriters using the serial interface, but it may not be C appropriate for other PostScript devices. C C PGPLOT_PS_MARKERS C Specify "NO" to suppress use of a PostScript font for the graph C markers; markers are then emulated by line-drawing. C C Document Structuring Conventions: C C The PostScript files conform to Version 3.0 of the Adobe Document C Structuring Conventions (see ref.3) and to version 3.0 of the C encapsulated PostScript file (EPSF) format. This should allow C the files to be read by other programs that accept the EPSF format. C Note, though, that multi-page plots are not valid EPSF files. The C files do not contain a screen preview section. C C References: C C (1) Adobe Systems, Inc.: PostScript Language Reference Manual. C Addison-Wesley, Reading, Massachusetts, 1985. C (2) Adobe Systems, Inc.: PostScript Language Tutorial and Cookbook. C Addison-Wesley, Reading, Massachusetts, 1985. C (3) Adobe Systems, Inc.: PostScript Language Reference Manual, Second C Edition. Addison-Wesley, Reading, Massachusetts, 1990. C----------------------------------------------------------------------- INTEGER DWD, DHT, DOFFW, DOFFH CHARACTER*(*) PTYPE, LTYPE, CPTYPE, CLTYPE, DEFNAM PARAMETER ( : PTYPE= 'VPS (PostScript file, portrait orientation)', : LTYPE= 'PS (PostScript file, landscape orientation)', : CPTYPE='VCPS (Colour PostScript file, portrait orientation)', : CLTYPE='CPS (Colour PostScript file, landscape orientation)') C PARAMETER (PTYPE='VPS', LTYPE='PS', CPTYPE='VCPS', CLTYPE='CPS') PARAMETER (DEFNAM='pgplot/ps') C -- printable paper area: in milli-inches; (WIDTH, HEIGHT) are C the dimensions of the printable area; OFFW, OFFH the offset from C the lower left corner of the paper PARAMETER (DWD=7800, DHT=10500, DOFFW=350, DOFFH=250) C INTEGER WIDTH, HEIGHT, OFFW, OFFH SAVE WIDTH, HEIGHT, OFFW, OFFH INTEGER IER, I0, J0, I1, J1, L, LL, LASTI, LASTJ, UNIT, LOBUF SAVE LASTI, LASTJ, UNIT, LOBUF INTEGER CI, LW, NPTS, NPAGE, IOERR, LFNAME SAVE LW, NPTS, NPAGE, IOERR, LFNAME INTEGER STATE SAVE STATE INTEGER NXP, NYP, XORG, YORG, XLEN, YLEN, N, RGB(3) INTEGER HIGH, LOW, I, K, KMAX, POSN, LD, LU INTEGER BBOX(4), BB1, BB2, BB3, BB4 SAVE BBOX INTEGER GROPTX, GRCTOI LOGICAL START, LANDSC, COLOR, STDOUT SAVE START, COLOR, STDOUT REAL BBXMIN, BBXMAX, BBYMIN, BBYMAX SAVE BBXMIN, BBXMAX, BBYMIN, BBYMAX REAL RVALUE(0:255), GVALUE(0:255), BVALUE(0:255) SAVE RVALUE, GVALUE, BVALUE CHARACTER*20 SUSER, SDATE CHARACTER*120 INSTR, MSG CHARACTER*132 OBUF SAVE OBUF CHARACTER*255 FNAME SAVE FNAME INTEGER MARKER(0:31), NSYM, RAD(0:31) SAVE MARKER, RAD REAL MFAC SAVE MFAC REAL SHADE(0:15), RINIT(0:15), GINIT(0:15), BINIT(0:15) SAVE SHADE, RINIT, GINIT, BINIT CHARACTER*1 HEXDIG(0:15) INTEGER IREGS(0:7) DATA HEXDIG/'0','1','2','3','4','5','6','7', 1 '8','9','A','B','C','D','E','F'/ DATA SHADE /1.00, 13*0.00, 0.33, 0.67/ DATA RINIT 1 / 1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 2 1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67/ DATA GINIT 1 / 1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00, 2 0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67/ DATA BINIT 1 / 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00, 2 0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67/ DATA RAD/ 6, 1, 7, 6, 7, 5, 6, 8, : 7, 7, 9, 10, 9, 8, 6, 8, : 4, 5, 9, 12, 2, 4, 5, 7, : 11, 17, 22, 41, 9, 9, 9, 9/ DATA STATE/0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,900,900,260,900,280,290), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 IF (MODE.EQ.1) THEN C -- landscape, monochrome CHR = LTYPE LCHR = LEN(LTYPE) ELSE IF (MODE.EQ.2) THEN C -- portrait, monochrome CHR = PTYPE LCHR = LEN(PTYPE) ELSE IF (MODE.EQ.3) THEN C -- landscape, color CHR = CLTYPE LCHR = LEN(CLTYPE) ELSE C -- portrait, color CHR = CPTYPE LCHR = LEN(CPTYPE) END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = -1 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1000.0 RBUF(2) = 1000.0 RBUF(3) = 5 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, Area fill, C Thick lines, QCR, Markers [optional]) C 40 CONTINUE CHR = 'HNNATNQNYM' C -- Marker support suppressed? CALL GRGENV('PS_MARKERS', INSTR, L) IF (L.GE.2) THEN IF (INSTR(1:L).EQ.'NO' .OR. INSTR(1:L).EQ.'no') THEN CHR(10:10) = 'N' END IF END IF LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(3) = 0 LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN RBUF(2) = HEIGHT-1 RBUF(4) = WIDTH-1 ELSE RBUF(2) = WIDTH-1 RBUF(4) = HEIGHT-1 END IF NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 8 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT PostScript file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF C -- Color mode? CALL GRGENV('PS_COLOR', INSTR, L) COLOR = L.GT.0 .OR. MODE.EQ.3 .OR. MODE.EQ.4 IF (COLOR) THEN DO 91 CI=0,15 RVALUE(CI) = RINIT(CI) GVALUE(CI) = GINIT(CI) BVALUE(CI) = BINIT(CI) 91 CONTINUE ELSE DO 92 CI=0,15 RVALUE(CI) = SHADE(CI) GVALUE(CI) = SHADE(CI) BVALUE(CI) = SHADE(CI) 92 CONTINUE END IF DO 93 CI=16,255 RVALUE(CI) = 0.0 GVALUE(CI) = 0.0 BVALUE(CI) = 0.0 93 CONTINUE C -- Device dimensions WIDTH = DWD HEIGHT = DHT OFFW = DOFFW OFFH = DOFFH CALL GRGENV('PS_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) WIDTH = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) HEIGHT = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_HOFFSET', INSTR, L) LL = 1 IF (L.GT.0) OFFW = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_VOFFSET', INSTR, L) LL = 1 IF (L.GT.0) OFFH = GRCTOI(INSTR(:L),LL) STDOUT =CHR(1:LCHR).EQ.'-' IF (STDOUT) THEN UNIT = 6 C -- machine-dependent! ELSE CALL GRGLUN(UNIT) END IF NBUF = 2 RBUF(1) = UNIT IF (.NOT.STDOUT) THEN IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN MSG = 'Cannot open output file for PostScript plot: '// 1 CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 94 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 94 END IF RBUF(2) = 1 FNAME = CHR(:LCHR) LFNAME = LCHR END IF ELSE RBUF(2) = 1 FNAME = '-' LFNAME= 1 END IF STATE = 1 IOERR = 0 LOBUF = 0 LASTI = -1 LASTJ = -1 LW = 1 NPTS = 0 CALL GRGENV('PS_EOF', INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, CHAR(4)) CALL GRPS02(IOERR, UNIT, '%!PS-Adobe-3.0 EPSF-3.0') CALL GRUSER(INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, '%%For: '//INSTR(1:L)) CALL GRPS02(IOERR, UNIT, '%%Title: PGPLOT PostScript plot') CALL GRPS02(IOERR, UNIT, '%%Creator: PGPLOT') CALL GRDATE(INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, : '%%CreationDate: '//INSTR(1:L)) CALL GRGENV('PS_BBOX', INSTR, L) CALL GRTOUP(INSTR(1:3), INSTR(1:3)) IF (INSTR(1:3).EQ.'MAX') THEN C -- bounding box is based on maximum plot dimensions, not C actual dimensions CALL GRFAO('%%BoundingBox: # # # #', L, INSTR, : NINT(OFFW*0.072), NINT(OFFH*0.072), : NINT((WIDTH+OFFW)*0.072), NINT((HEIGHT+OFFH)*0.072)) CALL GRPS02(IOERR, UNIT, INSTR(:L)) ELSE CALL GRPS02(IOERR, UNIT, '%%BoundingBox: (atend)') END IF CALL GRPS02(IOERR, UNIT, '%%DocumentFonts: (atend)') CALL GRPS02(IOERR, UNIT, '%%LanguageLevel: 1') LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN CALL GRPS02(IOERR, UNIT, '%%Orientation: Landscape') ELSE CALL GRPS02(IOERR, UNIT, '%%Orientation: Portrait') END IF CALL GRPS02(IOERR, UNIT, '%%Pages: (atend)') CALL GRPS02(IOERR, UNIT, '%%EndComments') CALL GRPS02(IOERR, UNIT, '%%BeginProlog') CALL GRPS02(IOERR, UNIT, 1 '/L {moveto rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, 1 '/C {rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, 1 '/D {moveto 0 0 rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, '/SLW {5 mul setlinewidth} bind def') CALL GRPS02(IOERR, UNIT, '/SCF /pop load def') CALL GRPS02(IOERR, UNIT, '/BP {newpath moveto} bind def') CALL GRPS02(IOERR, UNIT, '/LP /rlineto load def') CALL GRPS02(IOERR, UNIT, 1 '/EP {rlineto closepath eofill} bind def') CALL GRPS02(IOERR, UNIT, '/MB {gsave translate MFAC dup scale '// 1 '1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def') CALL GRPS02(IOERR, UNIT, '/ME /grestore load def') CALL GRPS02(IOERR, UNIT, '/CC {0 360 arc stroke} bind def') CALL GRPS02(IOERR, UNIT, '/FC {0 360 arc fill} bind def') CALL GRGENV('IDENT', INSTR, L) IF (L.GT.0) THEN CALL GRPS02(IOERR, UNIT, : '/RS{findfont exch scalefont setfont moveto dup'// : ' stringwidth neg exch neg exch rmoveto show} bind def') END IF CALL GRPS02(IOERR, UNIT, '%%EndProlog') NPAGE = 0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE CALL GRPS02(IOERR, UNIT, ' ') CALL GRPS02(IOERR, UNIT, '%%Trailer') CALL GRGENV('PS_BBOX', INSTR, L) CALL GRTOUP(INSTR(1:3), INSTR(1:3)) IF (INSTR(1:3).NE.'MAX') THEN CALL GRFAO('%%BoundingBox: # # # #', L, INSTR, : BBOX(1), BBOX(2), BBOX(3), BBOX(4)) CALL GRPS02(IOERR, UNIT, INSTR(:L)) END IF CALL GRPS02(IOERR, UNIT, '%%DocumentFonts: ') CALL GRFAO('%%Pages: #', L, INSTR, NPAGE, 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '%%EOF') CALL GRGENV('PS_EOF', INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, CHAR(4)) IF (IOERR.NE.0) THEN CALL GRWARN('++WARNING++ Error '// 1 'writing PostScript file: file is incomplete') CALL GRWARN('Check for device full or quota exceeded') CALL GRWARN('Filename: '//FNAME(:LFNAME)) END IF IF (.NOT.STDOUT) THEN CLOSE (UNIT, IOSTAT=IOERR) IF (IOERR.NE.0) THEN CALL GRWARN('Error closing PostScript file '//FNAME(:LFNAME)) END IF C set Acorn postscript file type IREGS(0)=18 FNAME(LFNAME+1:LFNAME+1)=?H00 IREGS(1)=LOCC(FNAME(1:LFNAME+1)) IREGS(2)=?I0FF5 C do OS_File,18,"name",&FF5 CALL SWIF77(8,IREGS,IDUM) C end Acorn mod. CALL GRFLUN(UNIT) END IF STATE = 0 RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN HEIGHT = RBUF(1) WIDTH = RBUF(2) ELSE WIDTH = RBUF(1) HEIGHT = RBUF(2) END IF NPAGE = NPAGE+1 CALL GRPS02(IOERR, UNIT, ' ') CALL GRFAO('%%Page: # #', L, INSTR, NPAGE, NPAGE, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '%%BeginPageSetup') CALL GRPS02(IOERR, UNIT, '/PGPLOT save def') CALL GRPS02(IOERR, UNIT, '0.072 0.072 scale') LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN CALL GRFAO('# # translate 90 rotate', L, INSTR, WIDTH+OFFW, 1 OFFH, 0, 0) ELSE CALL GRFAO('# # translate', L, INSTR, OFFW, OFFH, 0, 0) END IF CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '1 setlinejoin 1 setlinecap 1 SLW 1 SCF') CALL GRPS02(IOERR, UNIT, '%%EndPageSetup') CALL GRPS02(IOERR, UNIT, '%%PageBoundingBox: (atend)') DO 111 NSYM=0,31 MARKER(NSYM) = 0 111 CONTINUE MFAC = 0.0 BBXMIN = WIDTH BBYMIN = HEIGHT BBXMAX = 0.0 BBYMAX = 0.0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN C -- suppress zero-length continuation segment IF (I0.EQ.I1 .AND. J0.EQ.J1) RETURN CALL GRFAO('# # C', L, INSTR, (I1-I0), (J1-J0), 0, 0) ELSE CALL GRFAO('# # # # L', L, INSTR, (I1-I0), (J1-J0), I0, J0) END IF LASTI = I1 LASTJ = J1 BBXMIN = MIN(BBXMIN, I0-LW*5.0, I1-LW*5.0) BBXMAX = MAX(BBXMAX, I0+LW*5.0, I1+LW*5.0) BBYMIN = MIN(BBYMIN, J0-LW*5.0, J1-LW*5.0) BBYMAX = MAX(BBYMAX, J0+LW*5.0, J1+LW*5.0) GOTO 800 C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) CALL GRFAO('# # D', L, INSTR, I1, J1, 0, 0) LASTI = I1 LASTJ = J1 BBXMIN = MIN(BBXMIN, I1-LW*5.0) BBXMAX = MAX(BBXMAX, I1+LW*5.0) BBYMIN = MIN(BBYMIN, J1-LW*5.0) BBYMAX = MAX(BBYMAX, J1+LW*5.0) GOTO 800 C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (LOBUF.NE.0) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 C -- optionally write identification CALL GRGENV('IDENT', INSTR, L) IF (L.GT.0) THEN CALL GRUSER(SUSER, LU) CALL GRDATE(SDATE, LD) POSN = WIDTH - 1 IF (LANDSC) POSN = HEIGHT - 1 CALL GRFAO('('//SUSER(:LU)//' '//SDATE(:LD)// : ' [#]) # # 100 /Helvetica RS', : L, INSTR, NPAGE, POSN, 50, 0) CALL GRPS02(IOERR, UNIT, '0.0 setgray') CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF C -- optionally draw bounding box CALL GRGENV('PS_DRAW_BBOX', INSTR, L) IF (L.GT.0) THEN CALL GRFAO('0.0 setgray 0 SLW newpath # # moveto', L, INSTR, : NINT(BBXMIN), NINT(BBYMIN), 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) CALL GRFAO('# # lineto # # lineto', L, INSTR, : NINT(BBXMIN), NINT(BBYMAX), NINT(BBXMAX), NINT(BBYMAX)) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) CALL GRFAO('# # lineto closepath stroke', L,INSTR, : NINT(BBXMAX), NINT(BBYMIN), 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF CALL GRPS02(IOERR, UNIT, 'PGPLOT restore showpage') CALL GRPS02(IOERR, UNIT, '%%PageTrailer') IF (LANDSC) THEN BB1 = INT((WIDTH-BBYMAX+OFFW)*0.072) BB2 = INT((BBXMIN+OFFH)*0.072) BB3 = 1+INT((WIDTH-BBYMIN+OFFW)*0.072) BB4 = 1+INT((BBXMAX+OFFH)*0.072) ELSE BB1 = INT((BBXMIN+OFFW)*0.072) BB2 = INT((BBYMIN+OFFH)*0.072) BB3 = 1+INT((BBXMAX+OFFW)*0.072) BB4 = 1+INT((BBYMAX+OFFH)*0.072) END IF CALL GRFAO('%%PageBoundingBox: # # # #', L, INSTR, : BB1, BB2, BB3, BB4) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) IF (NPAGE.EQ.1) THEN BBOX(1) = BB1 BBOX(2) = BB2 BBOX(3) = BB3 BBOX(4) = BB4 ELSE BBOX(1) = MIN(BBOX(1),BB1) BBOX(2) = MIN(BBOX(2),BB2) BBOX(3) = MAX(BBOX(3),BB3) BBOX(4) = MAX(BBOX(4),BB4) END IF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) IF (COLOR) THEN WRITE(INSTR,'(3(F5.3,1X),''setrgbcolor'')') 1 RVALUE(CI), GVALUE(CI), BVALUE(CI) L = 29 ELSE WRITE(INSTR,'(F5.3,1X,''setgray'')') RVALUE(CI) L = 13 END IF LASTI = -1 GOTO 800 C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (LOBUF.NE.0) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) START = .TRUE. RETURN ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) IF (START) THEN CALL GRFAO('# # BP', L, INSTR, I0, J0, 0, 0) START = .FALSE. LASTI = I0 LASTJ = J0 ELSE IF (NPTS.EQ.0) THEN CALL GRFAO('# # EP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = -1 LASTJ = -1 ELSE CALL GRFAO('# # LP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = I0 LASTJ = J0 END IF BBXMIN = MIN(BBXMIN, I0-LW*5.0) BBXMAX = MAX(BBXMAX, I0+LW*5.0) BBYMIN = MIN(BBYMIN, J0-LW*5.0) BBYMAX = MAX(BBYMAX, J0+LW*5.0) GOTO 800 END IF C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (COLOR) THEN CI = RBUF(1) RVALUE(CI) = RBUF(2) GVALUE(CI) = RBUF(3) BVALUE(CI) = RBUF(4) ELSE CI = RBUF(1) RVALUE(CI) = 0.30*RBUF(2) + 0.59*RBUF(3) + 0.11*RBUF(4) GVALUE(CI) = RVALUE(CI) BVALUE(CI) = RVALUE(CI) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE LW = NINT(RBUF(1)) CALL GRFAO('# SLW', L, INSTR, LW, 0, 0, 0) LASTI = -1 GOTO 800 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE IF (LOBUF.NE.0) THEN C -- flush buffer first CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF CALL GRPS02(IOERR, UNIT, CHR(:LCHR)) LASTI = -1 RETURN C C--- IFUNC=26, Image.--------------------------------------------------- C 260 CONTINUE N = RBUF(1) IF (N.EQ.0) THEN C -- First: setup for image C -- Set clipping region (RBUF(2...5)) NXP = RBUF(2) NYP = RBUF(3) XORG = RBUF(4) XLEN = RBUF(5) - RBUF(4) YORG = RBUF(6) YLEN = RBUF(7) - RBUF(6) BBXMIN = MIN(BBXMIN, RBUF(4), RBUF(5)) BBXMAX = MAX(BBXMAX, RBUF(4), RBUF(5)) BBYMIN = MIN(BBYMIN, RBUF(6), RBUF(7)) BBYMAX = MAX(BBYMAX, RBUF(6), RBUF(7)) C CALL GRPS02(IOERR, UNIT, 'gsave newpath') CALL GRFAO('# # moveto # 0 rlineto 0 # rlineto', L, INSTR, : XORG, YORG, XLEN, YLEN) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRFAO('# 0 rlineto closepath clip', L, INSTR, -XLEN, : 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) C -- CALL GRFAO('/picstr # string def', L, INSTR, NXP, 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRFAO('# # 8 [', L, INSTR, NXP, NYP, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) WRITE (INSTR, '(6(1PE10.3, 1X), '']'')') (RBUF(I),I=8,13) CALL GRPS02(IOERR, UNIT, INSTR(:67)) IF (COLOR) THEN CALL GRPS02(IOERR, UNIT, : '{currentfile picstr readhexstring pop} false 3 colorimage') ELSE CALL GRPS02(IOERR, UNIT, : '{currentfile picstr readhexstring pop} image') END IF ELSE IF (N.EQ.-1) THEN C -- Last: terminate image CALL GRPS02(IOERR, UNIT, 'grestore') ELSE C -- Middle: write N image pixels; each pixel uses 6 chars C in INSTR, so N must be <= 20. L = 0 KMAX = 1 IF (COLOR) KMAX = 3 DO 262 I=1,N CI = RBUF(I+1) RGB(1) = NINT(255.0*RVALUE(CI)) RGB(2) = NINT(255.0*GVALUE(CI)) RGB(3) = NINT(255.0*BVALUE(CI)) DO 261 K=1,KMAX HIGH = RGB(K)/16 LOW = RGB(K)-16*HIGH L = L+1 INSTR(L:L) = HEXDIG(HIGH) L = L+1 INSTR(L:L) = HEXDIG(LOW) 261 CONTINUE 262 CONTINUE CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF RETURN C C--- IFUNC=28, Marker.-------------------------------------------------- C 280 CONTINUE NSYM = NINT(RBUF(1)) C -- Output code for this marker if necessary IF (MARKER(NSYM).EQ.0) THEN IF (LOBUF.GT.0) CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 CALL GRPS03(IOERR, NSYM, UNIT) MARKER(NSYM) = 1 END IF C -- Output scale factor IF (RBUF(4).NE.MFAC) THEN IF (LOBUF.GT.0) CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 MFAC = RBUF(4) WRITE (INSTR, '(''/MFAC '',F10.3,'' def'')') MFAC CALL GRPS02(IOERR, UNIT, INSTR(1:24)) END IF C -- Output an instruction to draw one marker I1 = NINT(RBUF(2)) J1 = NINT(RBUF(3)) CALL GRFAO('# # M#', L, INSTR, I1, J1, NSYM, 0) LASTI = -1 BBXMIN = MIN(BBXMIN, I1-MFAC*RAD(NSYM)) BBXMAX = MAX(BBXMAX, I1+MFAC*RAD(NSYM)) BBYMIN = MIN(BBYMIN, J1-MFAC*RAD(NSYM)) BBYMAX = MAX(BBYMAX, J1+MFAC*RAD(NSYM)) GOTO 800 C C--- IFUNC=29, Query color representation.------------------------------ C 290 CONTINUE CI = NINT(RBUF(1)) NBUF = 4 RBUF(2) = RVALUE(CI) RBUF(3) = GVALUE(CI) RBUF(4) = BVALUE(CI) RETURN C C----------------------------------------------------------------------- C Buffer output if possible. C 800 IF ( (LOBUF+L+1). GT. 132) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) OBUF(1:L) = INSTR(1:L) LOBUF = L ELSE IF (LOBUF.GT.1) THEN LOBUF = LOBUF+1 OBUF(LOBUF:LOBUF) = ' ' END IF OBUF(LOBUF+1:LOBUF+L) = INSTR(1:L) LOBUF = LOBUF+L END IF RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG, 1 '(''Unimplemented function in PS device driver: '',I10)') IFUNC CALL GRWARN(MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END C*GRPS03 -- PGPLOT PostScript driver, marker support C+ SUBROUTINE GRPS03(IOERR, NSYM, UNIT) INTEGER IOERR, NSYM, UNIT C C Write PostScript instructions for drawing graph marker number NSYM C on Fortran unit UNIT. C----------------------------------------------------------------------- CHARACTER*80 T(6) INTEGER I, N C IF (NSYM.LT.0 .OR. NSYM.GT.31) RETURN GOTO (100, 101, 102, 103, 104, 105, 106, 107, 108, 1 109, 110, 111, 112, 113, 114, 115, 116, 117, 2 118, 119, 120, 121, 122, 123, 124, 125, 126, 3 127, 128, 129, 130, 131) NSYM+1 C 100 T(1)='/M0 {MB -6 -6 moveto 0 12 rlineto 12 0 rlineto' T(2)='0 -12 rlineto closepath stroke ME} bind def' N=2 GOTO 200 101 T(1)='/M1 {MB 0 0 1 FC ME} bind def' N=1 GOTO 200 102 T(1)='/M2 {MB 0 7 moveto 0 -14 rlineto -7 0 moveto' T(2)='14 0 rlineto stroke ME} bind def' N=2 GOTO 200 103 T(1)='/M3 {MB 0 6 moveto 0 -6 lineto -5 3 moveto 5 -3 lineto' T(2)='5 3 moveto -5 -3 lineto stroke ME} bind def' N=2 GOTO 200 104 T(1)='/M4 {MB 0 0 7 CC ME} bind def' N=1 GOTO 200 105 T(1)='/M5 {MB -5 -5 moveto 10 10 rlineto -5 5 moveto' T(2)='10 -10 rlineto stroke ME} bind def' N=2 GOTO 200 106 T(1)='/M6 {MB -6 -6 moveto 0 12 rlineto 12 0 rlineto' T(2)='0 -12 rlineto closepath stroke ME} bind def' N=2 GOTO 200 107 T(1)='/M7 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='stroke ME} bind def' N=2 GOTO 200 108 T(1)='/M8 {MB 0 7 moveto 0 -14 rlineto -7 0 moveto 14 0 rlineto' T(2)='stroke 0 0 7 CC ME} bind def' N=2 GOTO 200 109 T(1)='/M9 {MB 0 0 1 FC 0 0 7 CC ME} bind def' N=1 GOTO 200 110 T(1)='/M10 {MB -9 9 moveto -8 7 lineto -7 3 lineto -7 -3 lineto' T(2)='-8 -7 lineto -9 -9 lineto -7 -8 lineto -3 -7 lineto' T(3)='3 -7 lineto 7 -8 lineto 9 -9 lineto 8 -7 lineto' T(4)='7 -3 lineto 7 3 lineto 8 7 lineto 9 9 lineto 7 8 lineto' T(5)='3 7 lineto -3 7 lineto -7 8 lineto closepath stroke' T(6)='ME} bind def' N=6 GOTO 200 111 T(1)='/M11 {MB 0 10 moveto -6 0 lineto 0 -10 lineto 6 0 lineto' T(2)='closepath stroke ME} bind def' N=2 GOTO 200 112 T(1)='/M12 {MB 0 9 moveto -2 3 lineto -8 3 lineto -3 -1 lineto' T(2)='-5 -7 lineto 0 -3 lineto 5 -7 lineto 3 -1 lineto 8 3' T(3)='lineto 2 3 lineto closepath stroke ME} bind def' N=3 GOTO 200 113 T(1)='/M13 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='fill ME} bind def' N=2 GOTO 200 114 T(1)='/M14 {MB -2 6 moveto -2 2 lineto -6 2 lineto -6 -2 lineto' T(2)='-2 -2 lineto -2 -6 lineto 2 -6 lineto 2 -2 lineto' T(3)='6 -2 lineto 6 2 lineto 2 2 lineto 2 6 lineto closepath' T(4)='stroke ME} bind def' N=4 GOTO 200 115 T(1)='/M15 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='0 -8 moveto 7 4 lineto -7 4 lineto closepath stroke ME}' T(3)='bind def' N=3 GOTO 200 116 T(1)='/M16 {MB -4 -4 moveto 0 8 rlineto 8 0 rlineto 0 -8' T(2)='rlineto closepath fill ME} bind def' N=2 GOTO 200 117 T(1)='/M17 {MB 0 0 4.5 FC ME} bind def' N=1 GOTO 200 118 T(1)='/M18 {MB 0 9 moveto -2 3 lineto -8 3 lineto -3 -1 lineto' T(2)=' -5 -7 lineto 0 -3 lineto 5 -7 lineto 3 -1 lineto 8 3' T(3)='lineto 2 3 lineto closepath fill ME} bind def' N=3 GOTO 200 119 T(1)='/M19 {MB -12 -12 moveto 0 24 rlineto 24 0 rlineto 0 -24' T(2)='rlineto closepath stroke ME} bind def' N=2 GOTO 200 120 T(1)='/M20 {MB 0 0 2 CC ME} bind def' N=1 GOTO 200 121 T(1)='/M21 {MB 0 0 4 CC ME} bind def' N=1 GOTO 200 122 T(1)='/M22 {MB 0 0 5 CC ME} bind def' N=1 GOTO 200 123 T(1)='/M23 {MB 0 0 7 CC ME} bind def' N=1 GOTO 200 124 T(1)='/M24 {MB 0 0 11 CC ME} bind def' N=1 GOTO 200 125 T(1)='/M25 {MB 0 0 17 CC ME} bind def' N=1 GOTO 200 126 T(1)='/M26 {MB 0 0 22 CC ME} bind def' N=1 GOTO 200 127 T(1)='/M27 {MB 0 0 41 CC ME} bind def' N=1 GOTO 200 128 T(1)='/M28 {MB -6 2 moveto -9 0 lineto -6 -2 lineto -3 5' T(2)='moveto -8 0 lineto -3 -5 lineto -8 0 moveto 9 0 lineto' T(3)='stroke ME} bind def' N=3 GOTO 200 129 T(1)='/M29 {MB 6 2 moveto 9 0 lineto 6 -2 lineto 3 5 moveto' T(2)='8 0 lineto 3 -5 lineto 8 0 moveto -9 0 lineto stroke ME}' T(3)='bind def' N=3 GOTO 200 130 T(1)='/M30 {MB 2 6 moveto 0 9 lineto -2 6 lineto 5 3 moveto' T(2)='0 8 lineto -5 3 lineto 0 8 moveto 0 -9 lineto stroke ME}' T(3)='bind def' N=3 GOTO 200 131 T(1)='/M31 {MB 2 -6 moveto 0 -9 lineto -2 -6 lineto 5 -3' T(2)='moveto 0 -8 lineto -5 -3 lineto 0 -8 moveto 0 9 lineto' T(3)='stroke ME} bind def' N=3 GOTO 200 C 200 DO 210 I=1,N CALL GRPS02(IOERR, UNIT, T(I)) 210 CONTINUE C END C*GRPS02 -- PGPLOT PostScript driver, copy buffer to file C+ SUBROUTINE GRPS02 (IER, UNIT, S) C C Support routine for PSdriver: write character string S on C specified Fortran unit. C C Error handling: if IER is not 0 on input, the routine returns C immediately. Otherwise IER receives the I/O status from the Fortran C write (0 => success). C----------------------------------------------------------------------- INTEGER IER, UNIT CHARACTER*(*) S C IF (IER.EQ.0) THEN WRITE (UNIT, '(A)', IOSTAT=IER) S IF (IER.NE.0) CALL 1 GRWARN('++WARNING++ Error writing PostScript file') END IF C----------------------------------------------------------------------- END -------------------------------pgplot/sys_arc/HicBoot010064400040640000322000000000400614117236400154450ustar00tjpcitmbr00000400000017Iconsprites .!Sprites pgplot/sys_arc/AAAREADME010064400040640000322000000324010635003406700153630ustar00tjpcitmbr00000400000017 PGPLOT Version 5.2.0 for the Archimedes June 1997 Distributed by 'Fortran Friends' P.O. Box 64, Didcot, Oxon OX11 0TH, UK. Email: BCA@ISISE.RL.AC.UK PGPLOT is a portable Fortran subroutine package for drawing simple scientific graphs. It runs on most mainframes on various graphics display devices and printers including inkjet and PostScript ones. It was originally developed for use with astronomical data reduction programs in the Caltech Astronomy department. It is freely available but copyright. This is an upgrade from the previous 'Fortran Friends' version 5.1.1 Archimedes version upgrade to the graphics driver: this now allows making the ouput directly into a sprite with driver type \ARCF, as opposed to direct to the screen with driver type \ARCV. It also works with RISC-OS up to version 3.6 although it can only make 16 or 256 colour sprites directly. More information, copies of the Fortran of the most recent version, and implementations for other computer systems may be obtained from: * Dr. T. J. Pearson * 105-24 California Institute of Technology, * Pasadena, California 91125, USA * * tjp@astro.caltech.edu * WWW: http://astro.caltech.edu/~tjp/pgplot/ * anonymous ftp: astro.caltech.edu If you do not have access to electronic mail, and want a copy of the complete portable Fortran source of version 5.2.0 of PGPlot, and the text of the current manual (dated 1989) written in TeX input format, send a blank, E format, 800K 3.5" floppy disk with a reply paid envelope to 'Fortran Friends' (address above) The data on that disc are compressed with !Squash, so you will need RISC-OS 3 to decompress them. Tim Pearson is in the process of rewriting the manual; pieces are currently available through WWW. A contribution of £1.00 (or U.S.$2.00) towards administration costs would be appreciated, or if your address is outside Europe £2.00 (or U.S.$5.00). Double these prices if you want us to supply the disc and packaging. The PGPlot library supplied on this disc has been compiled with Fortran Release 2 for the Archimedes. It must be installed on your Archimedes before you can compile the example programs supplied and run this package. Fortran Release 2 for Acorn computers is available for £99 (ex VAT) from: * Intelligent Interfaces Ltd, Tel. (01703) 261514 * P.O.Box 80, Fax. (01703) 267904 * Eastleigh, * Hants SO5 5YX, UK. Distribution disc contents: 1) The application !PGPlot: contains the !Boot, !Run and !Sprites needed to set up the environment for running PGPlot, together with the font file 'GRFont' and colour information in 'RGBTxt'. The HelpPGPlot text file has helpful information on the PGPlot functions in a format useable by !SrcEdit for on-line help. 2) The Copyright notice for PGPlot. 3) 'Examples' directory with the Fortran of the 14 demo programs and an explanation in the ReadMe. 4) 'lib' directory with the PGPlot library, and three auxiliary libraries which are PD utilities for primitive graphics and communication with the operating system and making 'hardcopy' output (sprites). 5) 'SYS_ARC' directory contains all the Archimedes specific code and instructions on how to create a library for new versions of PGPlot transferred electronically from the address above. Installing this version: 1) Copy the !PGPlot application to your working disc. 2) Copy the library files in the 'lib' directory to the directory where you keep Fortran libraries. Everyone should copy 'PGPlot'. If you have the !Fortran77 front-end from Intelligent Interfaces, or the Shareware 44 PD disc from Norwich Computer Services you will already have the other files 'Graphics', 'SpriteOp' and 'Utils', so may not need to copy them. In the Shareware !Fortran77 front-end you must include the name of this library in the 'LibList' file BEFORE the Graphics and Utils entries. 3) Copy the Examples directory to your working disc. 4) If you have !SrcEdit and want to use the on-line help, append the lines: PGplot none .HelpPGPlot to the file 'choices.languages' within the !SrcEdit application. Then install !SrcEdit on the icon bar, click menu over its icon, and change the options, language, to tick PGPlot. If you have !DeskEdit you can replace one of the 3 help files in the !DeskEdit.data directory with 'HelpPGPlot'. 5) Edit the !Run file if you want to change any of the global variables which set the default device type, screen colours etc. Testing the installation: 1) Before running any PGPLOT program, click on !PGPlot to set up the environment variables so that PGPLOT can find the fonts and colours. 2) Select the screen mode for your plots by setting the MODE from the RISC OS Desktop. This implementation of PGPlot is RISC OS compatible. It finds the Desktop screen mode before exiting the Desktop, runs your PGPlot program and returns to the Desktop on exit from your program. 3) Now try to compile, link and run the test demo programs. Remember the 'PGPlot' library should be linked before the 'Graphics', 'SptiteOp' and 'Utils' because it references routines in them. Warning: Most of the demos run quickly, but PGDemo3 takes some time, over 20 minutes on an A4000 with an ARM250 chip, and longer on an A3000. Invitation: If you feel inspired to improve this Archimedes version, look in the 'AAReadme' in the SYS_ARC directory for advice, and please send any enhancements to 'Fortran Friends' for distribution to others to enjoy. ************************ ReadMe for building the system ******************* PGPLOT on an Acorn Archimedes using Fortran release 2. D.J. & K.M. Crennell ('Fortran Friends') April 1996 P.O. Box 64, Didcot, Oxon OX11 0TH, UK. -------------------------------------------------------------------------- OBTAINING THE SOURCE The source code of PGPLOT is best obtained through anonymous ftp from astro.caltech.edu. If you do not have access to a relevant network, the source of version 5.2.0 may be obtained by sending £2.00 to cover costs (£3.00 from outside the UK) to K.M. Crennell at the above address. -------------------------------------------------------------------------- TESTED DRIVERS Currently only the following drivers have been tested under RISC-OS3: /NULL to plot onto the null device. /ARCV to use the Fortran Friends graphics library routines to plot to the screen. The driver uses the screen mode in use at the time the program is invoked; this must be have at least 16 colours. The first 16 colours are set to the defaults described in the PGPlot manual, the rest (up to 255) are pre-set to black. /ARCF as /ARCV but makes an Archimedes sprite with the name 'sprite/01' in the current directory. Subsequent screens are 'sprite/02' etc. The sprite is made in mode 27 for 16 colour representation and mode 28 (256 colours) for > 16 colour modes. The dimension of the sprite is that of the screen by default but may be changed with the variables: ARC_WIDTH and ARC_HEIGHT (pixels) as shown in the !Run file. /PS to produce a file that can be printed on a Postscript printer. /VPS to produce a 'vertical' or portrait mode Postscript file. /CPS to produce a colour Postscript file. /VCPS to produce a 'vertical' or portrait mode colour Postscript file. Please feel free to adapt drivers for other plotting devices and make them available to other users. A desktop compliant driver would be very welcome. -------------------------------------------------------------------------- INSTALLING PGPLOT It is assumed that you have transferred the following directories from California: 0) PGPLOT with text files AAAREADME, COPYRIGHT and the associated subdirectories: 1) SRC with the portable PGPlot source. This directory contains ~200 files, so concatenate the Fortran into 1 file, keeping the two include files separate. 2) SYS_ARC which contains all the Archimedes specific code, HicBoot and HicRun and the source of the device drivers 3) FONTS 4) EXAMPLES It is also assumed that you have the PD Fortran libraries 'Graphics', 'SpriteOp' and 'Utils' which are obtainable on the Shareware 44 Disk for £2 from: Norwich Computer Services, 96a Vauxhall Street, Norwich NR2 2SD, UK. These libraries are also supplied with the !Fortran77 utility at £25 from Intelligent Interfaces Ltd, P.O.Box 80, Eastleigh, Hants SO5 5YX, UK. Installation procedure Set up this directory structure on the Archimedes: !PGPlot - Examples - f77 (for the demo source code) f77 (for the PGPlot system code) SYS_ARC - f77 (for the Archimedes specific code) Copy: 1) the Examples ReadMe and Fortran source into the Examples and Examples.f77 directories. 2) the portable source file (call it PGPlot) and 2 include files (PGPLOT/IN and GRPCKG1/IN) from SRC into the f77 directory. 3) the contents of the SYS_ARC with its Fortran files into SYS_ARC and SYS_ARC.f77 4) the files GRFONT/TXT and RGB/TXT into !PGPlot rename the file RGB/TXT as RGBTxt. Then: 1) Edit the Fortran file in the !PGPlot.f77: a) change the all instances of the INCLUDE file names 'pgplot.inc' to 'f77.PGPLOT/IN' and 'grpckg1.inc' to 'f77.GRPCKG1/IN' b) Find the subroutine GRSYXD in the Fortran source, it has an INTEGER*2 declaration which is not supported by Archimedes Fortran. There is a non-standard version in your SYS_ARC.f77 which simulates the INTEGER*2 code. It was derived from the standard version dated: "15-Dec-1988 - standardize". Provided this is the version you have just imported then it is OK to remove it from the big source; part c) below will insert the new code. Otherwise you will have to improvise changes to the GRSYXD in SYS_ARC.f77 to reflect those in the newer version. c) similarly remove the function GRTRIM which falls into a Fortran system library bug. There is a replacement with a work-around in SYS_ARC.f77 which will be compiled automatically. d) add a card: INCLUDE 'SYS_ARC.f77.ArcInclude' at the end to include the Archimedes specific code. 2) Ensure that the two 'include' files are called PGPLOT/IN and GRPCKG1/IN. 3) make the Current Selected Directory your !PGPlot (*DIR ...!PGPlot). This is not necessary if you are using the !Fortran77 front-end from Intelligent Interfaces, or the one from Shareware 44 because they do this for you. 4) compile the code, creating the object file which can then be used as the PGPlot library. For convenience, move it into your Fortran libraries directory. Now make !PGPlot into an application: 1) copy to it the HicBoot as !Boot and HicRun as !Run from SYS_ARC and delete the originals. 2) make them into 'Obey' files (e.g. *SETTYPE !Boot FEB) 3) you will also need a !Sprites, so copy one from another application and correct it using the !Paint utility. The sprites should be renamed '!pgplot' and 'sm!pgplot' so that they will be displayed correctly in the filer window. 4) look at the !Run. It contains several statements setting up the PGPLOT_ variables required by PGPlot. You may want to alter these or set up some of your own. Click on the !PGPlot icon to initialise the global variables and sprites. -------------------------------------------------------------------------- SET UP THE FONTS 1) Compile, link and run the program SYS_ARC.f77.PGPack; this will create an UNFORMATTED file 'GRFont' in your !PGPlot application. 2) You may now delete the GRFONT/TXT. -------------------------------------------------------------------------- TRY THE EXAMPLES Now compile a demo, and link it with a command like: *Link -o demo1 aof.PGDemo1 lib.PGPlot lib.Utils lib.Graphics lib.f77 then: *Run demo1 This will first ask you for the device and should say that the default is /ARCV. Just press return to see the demo on the screen. -------------------------------------------------------------------------- SETTING UP THE HELP FILE 1) Compile, link and run the file: SYS_ARC.f77.ConvertHlp This will extract the help information from the PGPlot source (expected to be in f77.pgplot in your !PGPlot application) and create a new file 'HelpPGPlot' within your !PGPlot application. 2) If you have !SrcEdit and want to use the on-line help, append the lines: PGplot none .HelpPGPlot to the file 'choices.languages' within the !SrcEdit application. 3) if you have !DeskEdit you will have to replace one of the 3 help files in !DeskEdit.data (say Help_T) with the HelpPGPlot file you have just made. -------------------------------------------------------------------------- OTHER USEFUL PGPLOT ROUTINES Other directories you may find useful on the distribution from California are the APPLICATIONS, which contains some auxiliary programs but not all in portable code, and DRIVERS which has all the known device drivers. These are not usually portable, but you may find some of them a good start if you want to write a new driver of your own. We welcome any generally useful new utilities and device drivers for PGPlot. Please send them to 'Fortran Friends' at the above address so that we may include them in future issues. pgplot/sys_arc/HicRun010064400040640000322000000024420614117234700153170ustar00tjpcitmbr00000400000017| !Run file for PGPlot last update 13 Feb 1996 | | ensure the Floating point emulator and colourtrans are loaded | RMEnsure FPEmulator 0.00 RMLoad System:Modules.FPEmulator RMEnsure FPEmulator 0.00 Error You need the Floating-point Emulator RMEnsure ColourTrans 0.00 RMLoad System:Modules.Colours RMEnsure ColourTrans 0.00 Error You need the ColourTrans module | | now set up the global variables for PGPlot Set PGPLOT_DIR Iconsprites .!Sprites | | use SetMacro to avoid the 30 character maximum file name length bug. | SetMacro PGPLOT_FONT .GRFont SetMacro PGPLOT_RGB .RGBTxt | | change (or add to) the following to suit your taste | | default driver (Archi screen) Set PGPLOT_DEV /ARCV | default background colour Set PGPLOT_BACKGROUND black Set PGPLOT_IDENT "Fortran Friends" | PSDriver needs this Set PGPLOT_USER "Fortran Friends" | the following define the Postscript dimensions | they are inverted if you use /VPS or /VPCS Set PGPLOT_PS_WIDTH "7560" | PostScript width (Portrait) Set PGPLOT_PS_HEIGHT "11190" | Postscript height (Portrait) Set PGPLOT_ARC_WIDTH "800" | Sprite width (pixels for /ARCF driver) Set PGPLOT_ARC_HEIGHT "600" | Sprite height echo Global variables now set up for PGPlot pgplot/sys_bsd/aaaread.me010064400040640000322000000002510633467177000161140ustar00tjpcitmbr00000400000017The configuration file in this directory, from Henk Uijterwaal (RIPE-NCC) , is for BSDI Unix (e.g., on Dell hardware), using using gcc/g77. 1997-May-9 pgplot/sys_bsd/g77_gcc.conf010064400040640000322000000100440656367443300163060ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler (BSDI Unix). #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6/lib -lX11 -lm -lipc" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/drivers/old/vidriv.f010064400040640000322000000213710630071427400164470ustar00tjpcitmbr00000400000017 SUBROUTINE VIDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Impress (Imagen) device. C----------------------------------------------------------------------- C Derived from Pearson's IMDRIVER.FOR -- 01 June 1988 -- Ralph West C Modifications: C C Note: this is a preliminary release. The driver has the following C problems: (a) does not use hardware thick lines; (b) white lines do C not to erase background as they should; (c) lines are handled as C separate segments, instead of combining connected segments into paths, C which should be more efficient. C----------------------------------------------------------------------- C C Supported device: any Imagen printer that accepts the Impress page C description language. C C Device type code: /VIPRESS (portrait mode). C C Default file name: PGPLOT.VIPLOT. C C Default view surface dimensions: C 8 inches horizontal x 10.5 inches vertical (portrait mode). C Note that the Imagen laser printer cannot print on the C left-most vertical half inch of the sheet. C C Resolution: the driver uses coordinate increments of 1/300 inch. C The true resolution is device-dependent. C C Color capability: color indices 0 (erase), and 1 (black) C are supported. Requests for other color indices are C converted to 1. It is not possible to change color representation. C C Input capability: none. C C File format: binary, variable length records (max 1024 bytes); no C carriage control. C C Obtaining hardcopy: $ IMPRINT/IMPRESS file.type C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (DEFNAM='PGPLOT.VIPLOT') PARAMETER (TYPE='VIMPRESS') INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER BUFFER INTEGER BUFLEV INTEGER UNIT, IER INTEGER*2 I0, I1, J0, J1, NPTS INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER IC BYTE BUF(100), COLOR INTEGER NW INTEGER SIZEX, SIZEY PARAMETER (SIZEX=2400 ,SIZEY=3150) INTEGER OFFSETX, OFFSETY PARAMETER (OFFSETY=75, OFFSETX=15) C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in IMPRESS device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = SIZEX RBUF(3) = 0 RBUF(4) = SIZEY RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = 300.0 RBUF(2) = 300.0 C (multiple strokes are spaced by 1 pixels, or 1/300 inch) RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Hardcopy, No cursor, No dashed lines, Area fill, C no thick lines) C 40 CHR = 'HNNANNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = SIZEX RBUF(3) = 0 RBUF(4) = SIZEY NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 8.0 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- allocate buffer IER = GRGMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER RETURN END IF C -- open device CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER, 3 RECL=256) IF (IER.NE.0) THEN MSG = 'Cannot open output file for '//TYPE//' plot: ' : //CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IC = 1 C -- initialization NPTS = 0 COLOR = 15 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRWARN('Error deallocating plot buffer.') CALL GRGMSG(IER) END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C -- set coordinate system BUF(1) = 205 ! SET_HV_SYSTEM BUF(2) = 29 ! 0 0 3 5 BUF(3) = 135 ! SET_ABS_H BUF(4) = 0 BUF(5) = 0 BUF(6) = 137 ! SET_ABS_V BUF(7) = 0 BUF(8) = 0 NW = 8 GOTO 1000 C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IF (IC.EQ.0) RETURN I0 = OFFSETY + NINT(RBUF(2)) J0 = OFFSETX + SIZEX - NINT(RBUF(1)) I1 = OFFSETY + NINT(RBUF(4)) J1 = OFFSETX + SIZEX - NINT(RBUF(3)) 125 CONTINUE BUF(1) = 230 ! CREATE_PATH CALL GRIM00(BUF(2), 2) ! 2 vertices CALL GRIM00(BUF(4), I0) ! coordinates of vertices CALL GRIM00(BUF(6), J0) CALL GRIM00(BUF(8), I1) CALL GRIM00(BUF(10), J1) BUF(12) = 234 ! DRAW_PATH BUF(13) = COLOR ! black or white NW = 13 GOTO 1000 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IF (IC.EQ.0) RETURN I0 = OFFSETY + NINT(RBUF(2)) J0 = OFFSETX + SIZEX - NINT(RBUF(1)) I1 = I0 J1 = J0 GOTO 125 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE BUF(1) = 219 ! ENDPAGE NW = 1 GOTO 1000 C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF COLOR = 15 IF (IC.EQ.0) COLOR = 0 RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE CALL GRIM03(%val(BUFFER), UNIT, BUFLEV) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented. C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) BUF(1) = 230 ! CREATE_PATH CALL GRIM00(BUF(2), NPTS) ! # vertices NW = 3 ELSE NPTS = NPTS-1 I0 = OFFSETY + NINT(RBUF(2)) J0 = OFFSETX + SIZEX - NINT(RBUF(1)) CALL GRIM00(BUF(1), I0) ! coordinates of vertex CALL GRIM00(BUF(3), J0) NW = 4 IF (NPTS.EQ.0) THEN BUF(5) = 233 ! FILL_PATH BUF(6) = COLOR ! black or white NW = 6 END IF END IF GOTO 1000 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- Send the command. ------------------------------------------------- C 1000 CALL GRIM02(BUF,NW,%val(BUFFER),BUFLEV,UNIT) C----------------------------------------------------------------------- END pgplot/drivers/old/imdriv.f010064400040640000322000000255010563173024100164330ustar00tjpcitmbr00000400000017 SUBROUTINE IMDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Impress (Imagen) device. C----------------------------------------------------------------------- C Version 0.9 - 1987 Aug 19 - T. J. Pearson. C Modifications: C REW -- 23 MAY 1988 -- Orientation from x axis, not h axis C REW -- 25 MAY 1988 -- Change physical min/max C from 3074/2324 to 3150/2400 10.5 x 8) C REW -- 31 MAY 1988 -- Include x and y offsets to improve centering C C Note: this is a preliminary release. The driver has the following C problems: (a) does not use hardware thick lines; (b) white lines do C not to erase background as they should; (c) lines are handled as C separate segments, instead of combining connected segments into paths, C which should be more efficient. C----------------------------------------------------------------------- C C Supported device: any Imagen printer that accepts the Impress page C description language. C C Device type code: /IMPRESS (landscape mode). C C Default file name: PGPLOT.IMPLOT. C C Default view surface dimensions: C 10.5 inches horizontal x 8 inches vertical (landscape mode). C Note that the Imagen laser printer prints from the bottom edge C of the sheet and cannot print on the top half inch of the sheet. C C Resolution: the driver uses coordinate increments of 1/300 inch. C The true resolution is device-dependent. C C Color capability: color indices 0 (erase), and 1 (black) C are supported. Requests for other color indices are C converted to 1. It is not possible to change color representation. C C Input capability: none. C C File format: binary, variable length records (max 1024 bytes); no C carriage control. C C Obtaining hardcopy: $ IMPRINT/IMPRESS file.type C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (DEFNAM='PGPLOT.IMPLOT') PARAMETER (TYPE='IMPRESS') INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER BUFFER INTEGER BUFLEV INTEGER UNIT, IER INTEGER*2 I0, I1, J0, J1, NPTS INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER IC BYTE BUF(100), COLOR INTEGER NW INTEGER SIZEX, SIZEY ! REW -- 26MAY88 PARAMETER (SIZEX=3150 ,SIZEY=2400) ! REW -- 26MAY88 INTEGER OFFSETX, OFFSETY ! REW -- 31MAY88 PARAMETER (OFFSETX=75, OFFSETY=15) ! REW -- 31MAY88 C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in IMPRESS device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = SIZEX ! rew -- 25 may 1988 RBUF(3) = 0 RBUF(4) = SIZEY ! rew -- 25 may 1988 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = 300.0 RBUF(2) = 300.0 C (multiple strokes are spaced by 1 pixels, or 1/300 inch) RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Hardcopy, No cursor, No dashed lines, Area fill, C no thick lines) C 40 CHR = 'HNNANNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = SIZEX ! rew -- 25 May 1988 RBUF(3) = 0 RBUF(4) = SIZEY ! rew -- 25 May 1988 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 8.0 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- allocate buffer IER = GRGMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER RETURN END IF C -- open device CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER, 3 RECL=256) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IC = 1 C -- initialization NPTS = 0 COLOR = 15 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRWARN('Error deallocating plot buffer.') CALL GRGMSG(IER) END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C -- set coordinate system BUF(1) = 205 ! SET_HV_SYSTEM BUF(2) = 29 ! 0 0 3 5 ! REW -- 23 MAY 1988 BUF(3) = 135 ! SET_ABS_H BUF(4) = 0 BUF(5) = 0 BUF(6) = 137 ! SET_ABS_V BUF(7) = 0 BUF(8) = 0 NW = 8 GOTO 1000 C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IF (IC.EQ.0) RETURN I0 = OFFSETX + NINT(RBUF(1)) J0 = OFFSETY + NINT(RBUF(2)) I1 = OFFSETX + NINT(RBUF(3)) J1 = OFFSETY + NINT(RBUF(4)) 125 CONTINUE BUF(1) = 230 ! CREATE_PATH CALL GRIM00(BUF(2), 2) ! 2 vertices CALL GRIM00(BUF(4), I0) ! coordinates of vertices CALL GRIM00(BUF(6), J0) CALL GRIM00(BUF(8), I1) CALL GRIM00(BUF(10), J1) BUF(12) = 234 ! DRAW_PATH BUF(13) = COLOR ! black or white NW = 13 GOTO 1000 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IF (IC.EQ.0) RETURN I0 = OFFSETX + NINT(RBUF(1)) J0 = OFFSETY + NINT(RBUF(2)) I1 = I0 J1 = J0 GOTO 125 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE BUF(1) = 219 ! ENDPAGE NW = 1 GOTO 1000 C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF COLOR = 15 IF (IC.EQ.0) COLOR = 0 RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE CALL GRIM03(%val(BUFFER), UNIT, BUFLEV) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented. C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) BUF(1) = 230 ! CREATE_PATH CALL GRIM00(BUF(2), NPTS) ! # vertices NW = 3 ELSE NPTS = NPTS-1 I0 = OFFSETX + NINT(RBUF(1)) J0 = OFFSETY + NINT(RBUF(2)) CALL GRIM00(BUF(1), I0) ! coordinates of vertex CALL GRIM00(BUF(3), J0) NW = 4 IF (NPTS.EQ.0) THEN BUF(5) = 233 ! FILL_PATH BUF(6) = COLOR ! black or white NW = 6 END IF END IF GOTO 1000 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- Send the command. ------------------------------------------------- C 1000 CALL GRIM02(BUF,NW,%val(BUFFER),BUFLEV,UNIT) C----------------------------------------------------------------------- END C*GRIM00 -- PGPLOT Impress driver, write word C+ SUBROUTINE GRIM00(BUF,WORD) BYTE BUF(2), WORD(2) C-- BUF(1) = WORD(2) BUF(2) = WORD(1) END C*GRIM02 -- PGPLOT Impress driver, transfer data to buffer C+ SUBROUTINE GRIM02 (INSTR, N, BUFFER, HWM, UNIT) INTEGER N, HWM, UNIT BYTE INSTR(*), BUFFER(*) C C Arguments: C INSTR (input) : text of instruction (bytes). C N (input) : number of bytes to transfer. C BUFFER (input) : output buffer. C HWM (in/out) : number of bytes used in BUFFER. C UNIT (input) : channel number for output (when buffer is full). C C Subroutines called: C GRIM03 C----------------------------------------------------------------------- INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER I C----------------------------------------------------------------------- IF (HWM+N.GE.BUFSIZ) CALL GRIM03(BUFFER, UNIT, HWM) DO 10 I=1,N HWM = HWM + 1 BUFFER(HWM) = INSTR(I) 10 CONTINUE C----------------------------------------------------------------------- END C*GRIM03 -- PGPLOT Impress driver, copy buffer to file C+ SUBROUTINE GRIM03 (BUFFER, UNIT, N) BYTE BUFFER(*) INTEGER UNIT, N C C Arguments: C BUFFER (input) address of buffer to be output C UNIT (input) unit number for output C N (input) number of bytes to transfer C (output) set to zero C----------------------------------------------------------------------- INTEGER J C----------------------------------------------------------------------- IF (N.GT.0) WRITE (UNIT) (BUFFER(J),J=1,N) N = 0 C----------------------------------------------------------------------- END pgplot/drivers/old/irdriv.c010064400040640000322000000271020540415055000164310ustar00tjpcitmbr00000400000017/* From: Stephen Green */ /* To: tjp@deimos.caltech.edu */ #include #include /************************************************************************ * * irdriv -- IRIS4D PGPLOT Driver * * Stephen J. Green -- Aug. 16, 1990 National Research Council of Canada * * This driver handles the following capabilities: * * arbitrary sized view surface * 32 colors, 16 pre-defined * white background * buffering * a fully working cursor, with values returned for the mouse buttons * fast polygon and rectangle fill * * The device can be specfied by: * * "/IRIS" --> 7.8" x 7.8" window (640x640) * "X/IRIS" --> X" x X" window * "X,Y/IRIS" --> X" x Y" window * * X and Y are floating or integers, and have intelligent defaults. * */ /* * dev_name -- the PGPLOT device name * */ static char dev_name[] = "IRIS (SiliconGraphics Console)" ; /* * SCALE -- the number of pixels per inch * * This value is only good for typical Sun workstations, and will * result in a teeny window on high resolution workstations. Suns * are also slightly non-square, resulting in the X and Y scales * each being off from 82 by about 1 pixel in opposite directions. * */ #define SCALE 92 /* * DEF_*_WID -- default size of the screen * */ #define DEF_X_WID 640 #define DEF_Y_WID 640 /* * MAX_*_WID -- maximum size of the screen * */ #define MAX_X_WID 1024 #define MAX_Y_WID 1024 /* * MIN_*_WID -- minimum size of the screen * */ #define MIN_X_WID 50 #define MIN_Y_WID 50 /* * *_WID -- size of the screen * */ int X_WID = DEF_X_WID ; int Y_WID = DEF_Y_WID ; static int COLOR = 1 ; /* current pen color */ static int APPEND = 0 ; /* to erase or not */ /* * NCOLOR -- number of colors * * PGPLOT predefines 16 colors, and suntools uses the last color * for the cursor color, so the next factor of two (32) was used. * */ #define NCOLOR 32 /* The pre-defined dark grey color is too dark */ static unsigned char R_table[NCOLOR] = { 1,255,255, 0, 0, 0,255,255, 255, 0, 0, 0,127,255, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; static unsigned char G_table[NCOLOR] = { 1,255, 0,255, 0,255, 0,255, 127,142,255,127, 0, 0, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; static unsigned char B_table[NCOLOR] = { 1,255, 0, 0,255,255,255, 0, 0, 0,127,255,255,127, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; /* * These variables are used for the gl polygon fill routine * */ static long NPOLY = 0, POLY = 0 ; static Icoord VERTEX[1024][2]; unsigned char GR_cursor() ; /* get character at cursor */ void irdriv_( FUNC, BUFFER, NBUF, STRING, NSTR, len ) int *FUNC ; /* function */ float *BUFFER ; /* floating data */ int *NBUF ; /* length of BUFFER */ char *STRING ; /* character data */ int *NSTR ; /* length of STRING */ int len ; /* string length */ { int i ; int xpos, ypos ; float REQ_X_WID, REQ_Y_WID ; /* requested widths */ *NBUF = 0 ; *NSTR = 0 ; switch( *FUNC ) { /* *************** return device name ************************************* */ case 1: strcpy( STRING, dev_name ) ; *NSTR = strlen( dev_name ) ; for( i = *NSTR ; i < len ; i++ ) STRING[i] = ' ' ; break ; /* *************** return minimum range of view surface and color index *** */ case 2: BUFFER[0] = 0 ; /* minimum X value */ BUFFER[1] = X_WID - 1 ; /* maximum X value */ BUFFER[2] = 0 ; /* minimum Y value */ BUFFER[3] = Y_WID - 1 ; /* maximum Y value */ BUFFER[4] = 0 ; /* minimum color value */ BUFFER[5] = NCOLOR - 1 ; /* maximum color value */ *NBUF = 6 ; break ; /* *************** return device scale ************************************ */ case 3: BUFFER[0] = SCALE ; /* X units per inch */ BUFFER[1] = SCALE ; /* Y units per inch */ /* * The true pen with is, of course, 1 pixel, or 1.0 in device * coordinates, but this fails miserably for PGPLOT. A smaller * pen width helps somewhat, but I have not twiddled this parameter * enough to find the best value. the /CGI interface has similar * problems. * */ /* should really be 1.0 */ BUFFER[2] = 0.2 ; /* pen width */ *NBUF = 3 ; break ; /* *************** return device capabilities ***************************** */ case 4: STRING[0] = 'I' ; /* interactive device */ STRING[1] = 'C' ; /* cursor is available */ STRING[2] = 'D' ; /* no dashed lines */ STRING[3] = 'A' ; /* polygon fill available */ STRING[4] = 'T' ; /* T */ /* fat lines */ STRING[5] = 'R' ; /* rectangle fill available */ STRING[6] = 'N' ; /* not used */ STRING[7] = 'V' ; /* image lost on exit */ STRING[8] = 'N' ; /* not used */ STRING[9] = 'N' ; /* not used */ *NSTR = 10 ; break ; /* *************** return default device/file name ************************ */ case 5: STRING[0] = ' ' ; /* no default name */ break ; /* *************** return default size of view **************************** */ case 6: BUFFER[0] = 0 ; /* default X min */ BUFFER[1] = X_WID - 1 ; /* default X max */ BUFFER[2] = 0 ; /* default Y min */ BUFFER[3] = Y_WID - 1 ; /* default Y max */ *NBUF = 4 ; break ; /* *************** return miscellaneous defaults ************************** */ case 7: BUFFER[0] = 2.0 ; /* return a random number */ *NBUF = 1 ; break ; /* *************** select device ****************************************** */ case 8: /* do nothing */ break ; /* *************** open workstation *************************************** */ case 9: BUFFER[0] = 0.0 ; /* return channel 0 */ BUFFER[1] = 1.0 ; /* always successful open */ if( BUFFER[2] ) /* no-erase mode */ APPEND = 1 ; else APPEND = 0 ; *NBUF = 2 ; i = sscanf( STRING, "%f,%f", &REQ_X_WID, &REQ_Y_WID ) ; if( i == 1 ) { REQ_Y_WID = REQ_X_WID ; i = 2 ; } if( i == 2 ) { REQ_X_WID *= SCALE ; /* scale inches to pixels */ REQ_Y_WID *= SCALE ; /* scale inches to pixels */ if( REQ_X_WID < MIN_X_WID ) REQ_X_WID = DEF_X_WID ; if( REQ_X_WID > MAX_X_WID ) REQ_X_WID = MAX_X_WID - MIN_X_WID ; if( REQ_Y_WID < MIN_Y_WID ) REQ_Y_WID = DEF_Y_WID ; if( REQ_Y_WID > MAX_Y_WID ) REQ_Y_WID = MAX_Y_WID - MIN_Y_WID ; X_WID = REQ_X_WID ; Y_WID = REQ_Y_WID ; } GR_start() ; break ; /* *************** close workstation ************************************** */ case 10: break ; /* *************** begin picture ****************************************** */ case 11: concave(TRUE); if( !APPEND ) /* erase screen */ reshapeviewport(); RGBcolor(0,0,0); /* set to black */ clear(); /* set back to current color */ RGBcolor(R_table[COLOR],G_table[COLOR],B_table[COLOR]); break ; /* *************** draw line ********************************************** */ case 12: move2i((Icoord) BUFFER[0],(Icoord) BUFFER[1]); draw2((Icoord) BUFFER[2],(Icoord) BUFFER[3]); break ; /* *************** draw dot *********************************************** */ case 13: pnt2((Icoord) BUFFER[0], (Icoord) BUFFER[1]); break ; /* *************** end picture ******************************************** */ case 14: #ifdef CORRECT_END if( BUFFER[0] ) reshapeviewport(); RGBcolor(0,0,0); /* set to black */ clear(); /* set back to current color */ RGBcolor(R_table[COLOR],G_table[COLOR],B_table[COLOR]); #endif break ; /* *************** set color index **************************************** */ case 15: COLOR = BUFFER[0]; RGBcolor(R_table[COLOR],G_table[COLOR],B_table[COLOR]); break ; /* *************** flush buffer ******************************************* */ case 16: /* Empty */ break ; /* *************** read cursor ******************************************** */ case 17: xpos = BUFFER[0] ; ypos = BUFFER[1] ; STRING[0] = GR_cursor( &xpos, &ypos, "PGPLOT cursor input..." ) ; BUFFER[0] = xpos ; BUFFER[1] = ypos ; *NBUF = 2 ; *NSTR = 1 ; break ; /* *************** erase alpha screen ************************************* */ case 18: /* no alpha screen to erase */ break ; /* *************** set line style ***************************************** */ case 19: setlinestyle((short) (BUFFER[0] - 1)); break ; /* *************** polygon fill ******************************************* */ case 20: if( POLY == 0 ) { NPOLY = BUFFER[0] ; POLY = NPOLY ; } else { VERTEX[--POLY][0] = (Icoord) BUFFER[0] ; VERTEX[POLY][1] = (Icoord) BUFFER[1] ; if( POLY == 0 ) polf2i( NPOLY, VERTEX ) ; } break ; /* *************** set color represention ********************************* */ case 21: i = BUFFER[0] ; R_table[i] = 255.9 * BUFFER[1] ; G_table[i] = 255.9 * BUFFER[2] ; B_table[i] = 255.9 * BUFFER[3] ; break ; /* *************** set line width ***************************************** */ case 22: linewidth((short)BUFFER[0]); break ; /* *************** escape function **************************************** */ case 23: /* no escape functions */ break ; /* *************** rectangle fill ***************************************** */ case 24: rectfi((Icoord)BUFFER[0],(Icoord)BUFFER[1],(Icoord)BUFFER[2], (Icoord)BUFFER[3]); break ; /* *************** future unknown functions ******************************* */ default: *NBUF = -1 ; break ; } } /************************************************************************ * * * Suntools Dependent Garbage * * * ************************************************************************/ GR_start() { /* Open the window we have defined */ foreground(); prefposition(150,150+X_WID,150,150+Y_WID); winopen("PGPLOT"); /* Define our linestyles */ deflinestyle(1, 0x3EEE); /* Long dash */ deflinestyle(2, 0x6767); /* dot-dash-dot-dash */ deflinestyle(3, 0x5555); /* dotted */ deflinestyle(4, 0xFEEE); /* dash-dot-dot-dot */ /* set RGB mode for color interpretation */ RGBmode(); /* call gconfig to reset system values to defaults */ gconfig(); /* clear screen */ RGBcolor(0,0,0); clear(); RGBcolor(255,255,255); } /************************************************************************ * * * GR_cursor -- Wait for Events * * * ************************************************************************/ int x_cursor, y_cursor ; unsigned char c_cursor ; unsigned char GR_cursor( x, y, string ) int *x, *y ; char *string ; { /* definitions for use by queue commands */ long dev; short val; x_cursor = -1 ; y_cursor = -1 ; c_cursor = 0xff ; /* queue the events we wish to look for */ qdevice(KEYBD); qdevice(MOUSE3); /* print the string of instruction */ printf("%s\n",string); /* test the input queue until we have an event */ while( c_cursor == 0xff ) { if(qtest()) { dev = qread(&val); switch(dev) { case KEYBD: x_cursor = getvaluator(MOUSEX); y_cursor = getvaluator(MOUSEY); c_cursor = (unsigned char)val; break; case MOUSE3: x_cursor = getvaluator(MOUSEX); y_cursor = getvaluator(MOUSEY); c_cursor = 0x85; break; case REDRAW: reshapeviewport(); break; default: break; } } } /* unqueue the events and reset the queue */ unqdevice(KEYBD); unqdevice(MOUSE1); qreset(); *x = x_cursor ; *y = y_cursor ; return c_cursor ; } int X_WID = DEF_X_WID ; int Y_WID = DEF_Y_WID ; static int COLOR = 1 ; /* current pen color */ static int APPEND = 0 ; /* to erase or not */ /* * NCOLOR -- number of colors * * PGPLOT predefines 16 colors, and suntools uses the last color * for the cursor color, so the next factor of two (32) was used. * */ #define NCOLOR 32 /* The pre-defined dark grey color is too dark */ static unsigned char R_table[NCOLOR] = { 1,255,255pgplot/drivers/old/drivers.list010064400040640000322000000023360631627000100173400ustar00tjpcitmbr00000400000017! Obsolete PGPLOT drivers. !------------------------------------------------------------------------------ ! Move these drivers into the pgplot/drivers directory, and add these ! lines to pgplot/drivers.list if you really want to use any of these ! drivers. These drivers may not be compatible with PGPLOT v5.1 or later. !------------------------------------------------------------------------------ ! File Code Description Restrictions ! ARDRIV 0 /ARGS Sigma Args image device, 7000 series VMS ! GRDRIV 0 /GRINNELL Grinnell GMR-270 Image Display VMS ! IKDRIV 0 /IKON Digisolve Ikon Pixel Engine VMS ! IMDRIV 0 /IMPRESS Imagen printers (Impress language), landscape ! VIDRIV 0 /VIPRESS Imagen printers (Impress language), portrait ! IRDRIV 0 /IRIS SiliconGraphics Console SGI (C) ! LIDRIV 0 /LIACOM Liacom Graphic Video Display (GVD-02) VMS ! PKDRIV 0 /PK Peritek Corp. VCK-Q frame-buffer video VMS ! PZDRIV 0 /PERITEK Peritek Corp. VCH-Q frame-buffer video VMS ! SVDRIV 0 /SUNVIEW Sun workstations running SunView SunOS C ! VEDRIV 1 /VERSATEC Versatec V80 dot-matrix printer, landscape ! VEDRIV 2 /VVERSATEC Versatec V80 dot-matrix printer, portrait pgplot/drivers/old/ardriv.f010064400040640000322000000626410563171226700164460ustar00tjpcitmbr00000400000017C Date: 3-FEB-1988 15:08:50 GMT C From: AFT@AST-STAR.CAM.AC.UK C To: TJP@CITPHOBO C Subject: ARDRIVER.FOR SUBROUTINE ARDRIV(IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Args image device. C--- C Supported device: Sigma Args, 7000 series. C C Device type code: /ARgs. C C Default device name: ARGS_DEVICE (a logical name). C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 512 by 512 pixels. C C Color capability: Color indices 0-255 are supported. The default C representation is listed in Chapter 5 of the PGPLOT manual. The C representation of all color indices can be changed. C C Input capability: A cursor routine is provided that works on C Starlink Args devices. It is possible to move the cursor with C either the tracker ball or by using the arrow keys on the terminal C (SYS$COMMAND); the PF1 to PF4 keys can be used to control the rate C at which the arrow keys move the cursor. Terminate the cursor (in C all cases) by typing any printable character on the keyboard. C C File format: It is not possible to send ARGS plots to a disk file. C C Obtaining hardcopy: Not possible. C--- C 17-Jan-1988 - No longer requires GESUPPORT routines [AFT]. C 21-Sep-1986 - [AFT]. C 15-Oct-1986 - Modified to work on a Q-bus [AFT]. C 16-Jan-1988 - [AFT] C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($PRDEF)' INCLUDE '($SSDEF)' INCLUDE '($SYIDEF)' C CHARACTER MSG*10 INTEGER GRAR00, SYS$DASSGN, GRGMEM, IER INTEGER IOCODE, I, I0, J0, I1, J1, ICPU INTEGER*2 ITMP(10), ILEV, IOSB(4) INTEGER IREM, IWRT, IRD, ICHAN, MXCNT, ICNT, IBADR, ICOL SAVE IREM, IWRT, IRD, ICHAN, MXCNT, ICNT, IBADR, ICOL INTEGER MICRO, ITYPE SAVE MICRO, ITYPE LOGICAL APPEND SAVE APPEND C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,170,180,900,900, & 210,900,230) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in AR device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR='ARGS' LCHR=LEN(CHR) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=511 RBUF(3)=0 RBUF(4)=511 RBUF(5)=0 RBUF(6)=255 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=50.0 RBUF(2)=50.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- C I= Interactive device C C= Cursor C N= No hard dash C A= No area fill (not implemented) C N= No hard thick lines 40 CHR='ICNNNNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='ARGS_DEVICE' LCHR=LEN(CHR) NBUF=1 RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=511 RBUF(3)=0 RBUF(4)=511 RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 CALL INAR03(ICHAN,IWRT) RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 APPEND=RBUF(3).NE.0.0 RBUF(2)=GRAR00(ICHAN,CHR,LCHR) RBUF(1)=ICHAN C--- C- Allocate a buffer. Note, there could be a hardware interface C- bug for the ID driver which will cause the QIO to fail if the C- buffer starts on the last two words of a page. Since the address C- returned by GRGMEM begins on a quadword boundary, this C- condition can never arise. However, some care is required C- to make sure that the QIO to the Args only uses the buffer C- allocated with GRGMEM. C--- MXCNT=8192 IER=GRGMEM(MXCNT,IBADR) IF(IER .NE. SS$_NORMAL) THEN CALL GRGMSG(IER) CALL GRWARN('Unable to allocate virtual memory.') RBUF(2)=0 CALL SYS$DASSGN(%val(ICHAN)) RETURN END IF C--- C- If device opened remotely, set remote flag. Note, current C- driver does not support remote access. C--- IF(NINT(RBUF(2)).EQ.1) THEN IREM=0 ELSE IF(NINT(RBUF(2)).EQ.3) THEN IREM=1 RBUF(2)=1 ELSE C- Error condition. RETURN END IF C--- C- The QIO function is different for Unibus and Q-bus machines so C- detect CPU type. C--- CALL LIB$GETSYI(SYI$_CPU,ICPU) IF(ICPU.EQ.PR$_SID_TYPUV1 .OR. ICPU.EQ.PR$_SID_TYPUV2) THEN MICRO=1 ITYPE=1 IWRT=IO$_WRITEVBLK IRD =IO$_READVBLK ELSE MICRO=0 ITYPE=2 IWRT=IO$_WRITEVBLK IRD =IO$_READVBLK END IF C--- C- Init the buffer routine. C--- CALL INAR03(ICHAN,IWRT) CALL INAR01 C--- C- Cancel any outstanding I/O requests C--- CALL SYS$CANCEL(%val(ICHAN)) CALL SYS$WAITFR() C--- C- Reset interface. C--- IF(MICRO.EQ.0) THEN I=1 IOCODE=IOR(IWRT,I*'0040'x) CALL SYS$QIOW(,%val(ICHAN),%val(IOCODE),IOSB,,, & I,%val(I),,,,) ELSE I=2 IOCODE=IOR(IWRT,'2800'x) CALL SYS$QIOW(,%val(ICHAN),%val(IOCODE),IOSB,,, & %val(I),,,,,) END IF C--- C- Load default lookup table (if not appending). C--- IF(.NOT.APPEND) CALL GRAR10(%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CALL SYS$DASSGN(%val(ICHAN)) CALL GRFMEM(MXCNT,IBADR) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 CALL INAR01 IF(.NOT.APPEND) THEN ITMP(1)='3501'x ITMP(2)='FFFF'x ITMP(3)='0003'x ITMP(4)='0003'x ITMP(5)='0003'x ITMP(6)='3501'x ITMP(7)='FFFF'x CALL GRAR02(ITMP,14,%val(IBADR),ICNT,MXCNT) CALL GRAR03(%val(IBADR),ICNT) END IF APPEND=.FALSE. RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRAR01(I0,J0,I1,J1,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRAR01(I0,J0,I0,J0,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),255)) ITMP(1)='2901'x ITMP(2)=ICOL CALL GRAR02(ITMP,4,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 CALL GRAR03(%val(IBADR),ICNT) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- 170 I0=RBUF(1) J0=RBUF(2) CALL GRAR11(ICHAN,I0,J0,CHR,%val(IBADR),ICNT,MXCNT) RBUF(1)=I0 RBUF(2)=J0 NBUF=2 LCHR=1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=21, Set color representation. ------------------------------- 210 ITMP(1)=IOR('1800'x,0) ITMP(2)=NINT(RBUF(1)) ILEV=IAND(255,INT(RBUF(2)*255.999)) ITMP(3)=ILEV ILEV=IAND(255,INT(RBUF(3)*255.999)) ITMP(3)=ISHFT(ILEV,8)+ITMP(3) ILEV=IAND(255,INT(RBUF(4)*255.999)) ITMP(4)='FF00'x+ILEV CALL GRAR02(ITMP, 8, %val(IBADR), ICNT, MXCNT) RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C- Send CHR array directly to Args (user better know what he is doing!) 230 CALL GRAR02(%ref(CHR),LCHR,%val(IBADR),ICNT,MXCNT) RETURN C----------------------------------------------------------------------- END INTEGER FUNCTION GRAR00(LUN,CHR,LCHR) C----------------------------------------------------------------------- C GRPCKG (Args internal routine): Opens a QIO channel to the Args. C C GRAR00 (returns integer): 0 if the channel could not be opened C 1 if the channel was opened successfully on a local device, C 3 for a successful open of a channel over a network, C (the remote status of the C device must be flagged since, the QIO functions codes are C different when writting to a physical device or to the C network). C C 16-Jan-1988 - Modified from GESUPPORT routine [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER DVI$_DEVCLASS, DVI$_DEVNAM PARAMETER (DVI$_DEVCLASS=4) PARAMETER (DVI$_DEVNAM=32) INTEGER LUN,LCHR CHARACTER CHR*(*) INTEGER IER, ITEMP INTEGER DEVCLASS, ITMLIST(7), MOSB(2), ISTAT, LENGTH INTEGER SYS$ASSIGN, SYS$QIOW INTEGER SYS$GETDVI, SYS$DASSGN, SYS$WAITFR INTEGER*2 IOSB(4) LOGICAL WRONG C--- C- Assign an i/o channel C--- IER=SYS$ASSIGN(CHR(:LCHR), LUN,,) IF(IER.NE.SS$_NORMAL .AND. IER.NE.SS$_REMOTE) GOTO 900 IF(IER.EQ.SS$_REMOTE) THEN C--- C- Cannot check device characteristics easily if network device being used C- so just check whether we opened the device successfully and return C- Read back the status from assign to plotting device over network C--- IER=SYS$QIOW(,%VAL(LUN),%VAL(IO$_READVBLK), : IOSB,,,ISTAT,LENGTH,,,,) IF(IOSB(1) .NE. SS$_NORMAL) THEN CALL GRWARN ('Unable to read status from ASSIGN to' // : ' graphics device on remote node') WRITE(6,*) IOSB(2), ' bytes read' ITEMP=IOSB(1) CALL GRGMSG(ITEMP) GRAR00=0 RETURN END IF IF(ISTAT .NE. SS$_NORMAL) THEN IER=ISTAT GOTO 900 ELSE GRAR00=3 RETURN END IF END IF C--- C- Check that device has correct characteristics, C- and obtain true device name. C--- ITMLIST(1)=DVI$_DEVCLASS*2**16+4 ITMLIST(2)=%LOC(DEVCLASS) ITMLIST(3)=0 ITMLIST(4)=DVI$_DEVNAM*2**16+LEN(CHR) ITMLIST(5)=%LOC(CHR) ITMLIST(6)=%LOC(LCHR) ITMLIST(7)=0 IER=SYS$GETDVI(%VAL(0),,CHR(:LCHR), 1 ITMLIST,MOSB,,,) IF(.NOT.IER) GOTO 900 IER=SYS$WAITFR(%VAL(0)) IF(.NOT.IER) GOTO 900 IF(.NOT.MOSB(1)) THEN IER=MOSB(1) GOTO 900 END IF WRONG=DEVCLASS.NE.96 IF(WRONG) THEN CALL GRWARN( CHR(:LCHR)// 2 ' is the wrong sort of device for plot type.') IER=SYS$DASSGN(%VAL(LUN)) GOTO 990 END IF C--- C- Successful completion C--- GRAR00=1 RETURN C--- C- Error exit C--- 900 CALL GRWARN('Cannot open graphics device '//CHR(:LCHR)) CALL GRGMSG(IER) 990 GRAR00=0 END C********* SUBROUTINE GRAR01(I0,J0,I1,J1,IBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG(internal routine, ARGS): draw a line segment. C C Arguments: C C I0,J0(integer*2, input): the column and row numbers of the starting C point. C I1,J1(integer*2, input): the column and row numbers of the end point. C C Note: the arguments are specified as integer*2, but(on the VAX at C least) integer*4 values may be used. The values should be in the C range defined by the hardware:(0...511). C C 11-Apr-1983 C 7-Nov-1984 - KS/AAO) Some optimisation based on last position added. C----------------------------------------------------------------------- INTEGER I0, J0, I1, J1, ICNT, MXCNT INTEGER*2 IBUF INTEGER*2 CLIP511 INTEGER IPTR,X INTEGER*2 IC0, JC0, IC1, JC1, ITMP(4) INTEGER*2 LASTI, LASTJ SAVE LASTI, LASTJ C CLIP511(X)=X .AND. '1FF'x C IC0=CLIP511(I0) JC0=CLIP511(J0) IC1=CLIP511(I1) JC1=CLIP511(J1) C IF(IC0.NE.LASTI .OR. JC0.NE.LASTJ) THEN ITMP(1)=IOR(IC0,'C000'x) ITMP(2)=IOR(JC0,'A000'x) IPTR=3 ELSE IPTR=1 END IF ITMP(IPTR) =IOR(IC1,'C000'x) ITMP(IPTR+1)=IOR(JC1,'E000'x) LASTI=IC1 LASTJ=JC1 CALL GRAR02(ITMP,2*(IPTR+1),IBUF,ICNT,MXCNT) RETURN C ENTRY INAR01 LASTI=-1 LASTJ=-1 RETURN END C********* SUBROUTINE GRAR02(STR, N, QBUF, ICNT, MXCNT) C----------------------------------------------------------------------- C GRPCKG (Args internal routine): Transfer N bytes to C the output buffer, flushing the buffer as necessary with the C GRAR03 routine. If the N bytes will not fit into the current C buffer, then the buffer is first dumped. This is to to cause C STR to be transferred as a complete unit. C Based on early versions of GRxx02 routines, this version does not C use any common blocks. C ***NOTE*** INAR03 must be called before any calls to GRAR02 to C set the LUN/Channel to which the buffer should be dumped. C C Arguments: C C STR(N) I Byte Characters to be written. C N I I The number of bytes to transfer. C QBUF I/O Byte The output buffer. C ICNT I/O I Current number of bytes used in QBUF. C MXCNT I/O I Maximum number of bytes that can be stored C -in QBUF. C C 16-Jan-1988 - Based on GESUPPORT routine [AFT]. C----------------------------------------------------------------------- INTEGER ICNT,MXCNT,I,N BYTE QBUF(N), STR(N) C--- IF(ICNT+N.GE.MXCNT) CALL GRAR03(QBUF,ICNT) DO 100 I=1,N ICNT=ICNT+1 QBUF(ICNT)=STR(I) 100 CONTINUE RETURN END C********* SUBROUTINE GRAR03(QBUF,ICNT) C----------------------------------------------------------------------- C GRPCKG (Args internal routine): Write ICNT bytes in QBUF to the device C Reset ICNT to zero. C ***NOTE*** INAR03 must be called before any calls to GRAR02 to C set the correct Channel number. C This subroutine contains the entry point INAR03 that defines C the variables ICHAN and IFUNC. C C Arguments: C C QBUF I/O Byte The output buffer. C ICNT I/O I Current number of bytes used in QBUF. C C 16-Jan-1988 - Modified from GESUPPORT routines [AFT]. C----------------------------------------------------------------------- INCLUDE '($SSDEF)' INTEGER SYS$QIOW INTEGER ICNT BYTE QBUF(*) INTEGER RESULT, N INTEGER*2 IOSB(4) INTEGER INCHAN,INFUNC INTEGER ICHAN,IFUNC SAVE ICHAN,IFUNC C N=ICNT ICNT=0 IF(N.LT.1) RETURN C--- RESULT=SYS$QIOW(,%val(ICHAN),%val(IFUNC),IOSB,,, 1 QBUF(N+1),%val(4), 2 QBUF,%val(N/2),%val(8),) C--- IF(RESULT.NE.SS$_NORMAL) THEN CALL GRGMSG(RESULT) CALL GRWARN('SYS$QIOW error writing to device.') END IF IF(IOSB(1).NE.SS$_NORMAL) THEN CALL GRGMSG(IOSB(1)) CALL GRWARN('SYS$QIOW (IOSB) status writing to device.') END IF RETURN C--- ENTRY INAR03(INCHAN,INFUNC) C- Save info needed to dump buffer. ICHAN=INCHAN IFUNC=INFUNC RETURN END SUBROUTINE GRAR10(IBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG(internal routine, ARGS): advance the plotting area to a C new page. This routine is called for ARGS devices by GRPAGE to C reinitialize the display. C C 11-Apr-1983 C 7-Nov-1984 - Colour table code modified [KS/AAO]. C 21-Sep-1986 - Modified for use with GEDRIVER [AFT]. C----------------------------------------------------------------------- INTEGER MXCOL PARAMETER (MXCOL=16) C INTEGER ICNT, MXCNT INTEGER*2 IBUF C INTEGER IPTR, ICLR INTEGER*2 ITMP(257) C INTEGER*2 IRED(MXCOL), IBLUE(MXCOL), IGREEN(MXCOL) DATA IRED / 0,255,255, 0, 0, 0,255,255, & 255,127, 0, 0,127,255, 85,170/ DATA IGREEN/ 0,255, 0,255, 0,255, 0,255, & 127,255,255,127, 0, 0, 85,170/ DATA IBLUE / 0,255, 0, 0,255,255,255, 0, & 0, 0,127,255,255,127, 85,170/ C C Reset GSW to drawing mode,size and direction all zero, autoincrement on, C background overlay off, backwash off, cursor scroll disabled C ITMP(1)='0E00'x ! Load status word ITMP(2)='2000'x C C Reset Z status register to 32 bits and 0 offset. C ITMP(3)='0700'x ITMP(4)='1F00'x CALL GRAR02(ITMP,8,IBUF,ICNT,MXCNT) C C Reset VSR to display graphics and overlay C ITMP(1)='2401'x ITMP(2)='01C0'x ITMP(3)=0 ITMP(4)='0007'x CALL GRAR02(ITMP,8,IBUF,ICNT,MXCNT) C C Set origin to 0,0 C ITMP(1)='1000'x ! X Origin to 0 ITMP(2)=0 ITMP(3)='1100'x ! Y Origin to 0 ITMP(4)=0 C C Put pen at origin C ITMP(5)='C000'x ITMP(6)='A000'x C C Unzoom C ITMP(7)='5000'x ITMP(8)=0 CALL GRAR02(ITMP,16,IBUF,ICNT,MXCNT) C C No scroll C ITMP(1)='3901'x ITMP(2)='FFFF'x ITMP(3)=0 ITMP(4)='3B01'x ITMP(5)='FFFF'x ITMP(6)=0 CALL GRAR02(ITMP,12,IBUF,ICNT,MXCNT) C C Set write enable for lower 8 bit planes only C ITMP(1)='2D01'x ITMP(2)='00FF'x C C Turn on all planes C ITMP(3)='2B01'x ITMP(4)='FFFF'x CALL GRAR02(ITMP,8,IBUF,ICNT,MXCNT) C C Turn off lamps C ITMP(1)='3C40'x ITMP(2)='3C45'x ITMP(3)=0 CALL GRAR02(ITMP,6,IBUF,ICNT,MXCNT) C C Set colour table C IPTR=2 DO ICLR=1,MXCOL IPTR=IPTR+2 ITMP(IPTR-1)=IOR(ISHFT(IGREEN(ICLR),8),IRED(ICLR)) ITMP(IPTR) =IOR('FF00'x,IBLUE(ICLR)) END DO ITMP(1)=IOR('1800'x,MXCOL-1) ITMP(2)=0 CALL GRAR02(ITMP,2*IPTR,IBUF,ICNT,MXCNT) C C Flush ARGS Buffer C CALL GRAR03(IBUF,ICNT) C RETURN END SUBROUTINE GRAR11(ICHAN, IX, IY, CHR, IBUF, ICNT, MXCNT) INTEGER ICHAN, IX, IY, IBUF, ICNT, MXCNT CHARACTER CHR C C Arguments C ICHAN (input) QIO channel assigned to Args C IX,IY (in/out) The cursor position C CHR (output) The keyboard character pressed C IBUF (input) Address of a buffer area C ICNT (in/out) Number of bytes in use in buffer C MXCNT (input) Maximum size of buffer in bytes C--- C Read the cursor position on the Args. The cursor can be moved C by either rolling the tracker ball. C The cursor can also be moved by using the cursor keys on the C terminal associated with SYS$COMMAND in which case the cursor C "speed" (step size) is controlled by the PF1 (smallest step) to C PF4 (largest step) keys. The numeric keys on the keypad can be C used in place of the arrow keys, with the addition of diagonal C motion: C UP C 7 8 9 C LEFT 4 6 RIGHT C 1 2 3 C DOWN C--- C- 19-Jan-1988 - Modified to track VTDRIVER [AFT]. C--- INTEGER SMG$CREATE_VIRTUAL_KEYBOARD, SMG$READ_KEYSTROKE INTEGER IXWAS, IYWAS, ISTEP, IER, IVAL, IXINC, IYINC INTEGER SWITCH, IDSMG INTEGER*2 ITMP(10) LOGICAL QKEY C--- IER=SMG$CREATE_VIRTUAL_KEYBOARD(IDSMG,'SYS$COMMAND') IF(IER.NE.1) THEN CALL GRGMSG(IER) CALL GRQUIT('Fatal error.') END IF ITMP(1)='3C40'x CALL GRAR02(ITMP,2,IBUF,ICNT,MXCNT) CALL GRAR03(IBUF,ICNT) CALL GRAR21(IX,IY,.TRUE.,.FALSE.,IBUF,ICNT,MXCNT) IXWAS=IX IYWAS=IY QKEY=.FALSE. ISTEP=2 DO WHILE (.NOT.QKEY) C- See if user has typed something at keyboard. IER=SMG$READ_KEYSTROKE(IDSMG,IVAL,,0) IF(IER.NE.1) IVAL=0 IF(IVAL.EQ.259) THEN C- PF4=large step ISTEP=64 ELSE IF(IVAL.EQ.258) THEN ISTEP=8 ELSE IF(IVAL.EQ.257) THEN ISTEP=4 ELSE IF(IVAL.EQ.256) THEN C- PF1=small step ISTEP=1 ELSE IF(IVAL.EQ.49 .OR. IVAL.EQ.261) THEN C- key 1 or KP1 IX=IX-ISTEP IY=IY-ISTEP ELSE IF(IVAL.EQ.50 .OR. IVAL.EQ.262 .OR. IVAL.EQ.275) THEN C- key 2, KP2 or DOWN IY=IY-ISTEP ELSE IF(IVAL.EQ.51 .OR. IVAL.EQ.263) THEN C- key 3 or KP3 IX=IX+ISTEP IY=IY-ISTEP ELSE IF(IVAL.EQ.52 .OR. IVAL.EQ.264 .OR. IVAL.EQ.276) THEN C- key 4, KP4 or LEFT IX=IX-ISTEP ELSE IF(IVAL.EQ.54 .OR. IVAL.EQ.266 .OR. IVAL.EQ.277) THEN C- key 6, KP6 or RIGHT IX=IX+ISTEP ELSE IF(IVAL.EQ.55 .OR. IVAL.EQ.267) THEN C- key 7 or KP7 IX=IX-ISTEP IY=IY+ISTEP ELSE IF(IVAL.EQ.56 .OR. IVAL.EQ.268 .OR. IVAL.EQ.274) THEN C- key 8, KP8 or UP IY=IY+ISTEP ELSE IF(IVAL.EQ.57 .OR. IVAL.EQ.269) THEN C- key 9 or KP9 IX=IX+ISTEP IY=IY+ISTEP ELSE IF((IVAL.GT.0 .AND. IVAL.LT.48) .OR. & (IVAL.GT.57 .AND. IVAL.LT.255)) THEN QKEY=.TRUE. END IF CALL GRAR22(ICHAN,IXINC,IYINC,SWITCH,IBUF,ICNT) IX=IX+IXINC IY=IY+IYINC IY=MAX(IY,0) IY=MIN(IY,511) IX=MAX(IX,0) IX=MIN(IX,511) CALL GRAR21(IX,IY,.FALSE.,.FALSE.,IBUF,ICNT,MXCNT) IF(IX.NE.IXWAS.OR.IY.NE.IYWAS) THEN IXWAS=IX IYWAS=IY ELSE CALL LIB$WAIT(0.05) END IF END DO CHR=CHAR(IVAL) CALL GRAR21(IX,IY,.FALSE.,.TRUE.,IBUF,ICNT,MXCNT) C--- C- Free resources. CALL SMG$DELETE_VIRTUAL_KEYBOARD(IDSMG) RETURN END SUBROUTINE GRAR21(IX,IY,ON,OFF,IBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG (Internal routine, ARGS) Control position of ARGS cursor C C Arguments: C C IX,IY (Integer, input) Position to which cursor is to be moved. C ON (Logical, input) True if cursor is to be switched on. C OFF (Logical, input) True if cursor is to be switched off. C C If ON and OFF are both false, the cursor is positioned, but C is switched neither on nor off. If both are true, it is switched C on and then off. C C (08-Nov-1984 KS / AAO) C----------------------------------------------------------------------- LOGICAL ON,OFF INTEGER IX,IY,IBUF,ICNT,MXCNT C INTEGER*2 CURON(4),CUROFF(4),CURPOS(4) INTEGER NWORDS DATA CURON /'2401'X,'01F8'X,'0008'X,'0000'X/ DATA CUROFF/'2401'X,'01C0'X,'0000'X,'0000'X/ DATA CURPOS/'1700'X,'0000'X,'2700'X,'0000'X/ C CURPOS(2)=IX CURPOS(4)=IY CALL GRAR02(CURPOS,8,IBUF,ICNT,MXCNT) NWORDS=4 IF(ON) THEN CALL GRAR02(CURON,8,IBUF,ICNT,MXCNT) NWORDS=NWORDS+4 END IF IF(OFF) THEN CALL GRAR02(CUROFF,8,IBUF,ICNT,MXCNT) NWORDS=NWORDS+4 END IF CALL GRAR03(IBUF,ICNT) C END SUBROUTINE GRAR22(ICHAN,IX,IY,SWITCH,IBUF,ICNT) C-------------------------------------------------------------------- C GRPCKG (Internal routine, ARGS) Read trackerball values C C Arguments - C C IX,IY (Integer, output) Change in trackerball position in X and Y C since this routine was last called. C SWITCH (Integer, output) Switch status word. Bits 3 through 6 C indicate switch operations since last C read. C C Note: the trackerball must have been reset at some point before C the first call to this routine. C C 13-Dec-1984 - [KS/AAO] C 21-Mar-1987 - Should now work on micro-VAX [PWH/AFT] C---------------------------------------------------------------------- INCLUDE '($PRDEF)' INCLUDE '($SYIDEF)' C INTEGER ICHAN, IX, IY, SWITCH, IBUF, ICNT C INCLUDE '($IODEF)' C INTEGER ICPU, IOSTAT, IER, SYS$QIOW INTEGER*2 IOSB(4), SBUFF(7) INTEGER*2 READC(5) DATA READC/0,0,0,0,'3C44'X/ C C- Read trackerball. C CALL GRAR03(IBUF,ICNT) CALL LIB$GETSYI(SYI$_CPU,ICPU) IF(ICPU.EQ.PR$_SID_TYPUV1 .OR. ICPU.EQ.PR$_SID_TYPUV2) THEN C--- C- On Micro-VAX (Q-bus). IER=SYS$QIOW(,%val(ICHAN),%val(IO$_WRITEVBLK),IOSB,,, & READC(5), %val(2), %val(5),,,) IER=SYS$QIOW(,%val(ICHAN),%val(IO$_READVBLK),IOSB,,, & SBUFF(5), %val(6), %val(5),,,) ELSE C--- C- On Unibus. IER=SYS$QIOW(,%val(ICHAN),%val(IO$_READVBLK),IOSB,,, & READC, %val(5),SBUFF,%val(7),,) END IF IOSTAT=IOSB(1) IF(.NOT.IER) IOSTAT=IER IF(.NOT.IOSTAT) THEN CALL GRGMSG(IOSTAT) CALL GRQUIT('SYS$QIOW failure reading from ARGS') END IF C IX=SBUFF(5) IY=SBUFF(6) SWITCH=SBUFF(7) C END CALL GRGMSG(RESULT) CALL GRWARN('SYS$QIOW error writing to device.') pgplot/drivers/old/grdriv.f010064400040640000322000000544150563172157500164560ustar00tjpcitmbr00000400000017C*GRDRIV -- PGPLOT Grinnell driver C+ SUBROUTINE GRDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Grinnell device. C C Version 1.0 - 1987 May 26 - T. J. Pearson. C Version 1.1 - 1987 Jun 6 - dynamically allocate buffer (TJP). C Version 1.2 - 1988 Jan 11 - use SMG$ routines for keyboard control C of cursor (TJP). C Version 1.3 - 1988 Mar 16 - test GR_TYPE environment variable (TJP). C Version 1.4 - 1988 Mar 28 - correct bug in /APPEND (TJP). C Version 1.5 - 1989 Feb 11 - add MONOCHROME option (TJP). C C C Supported device: Grinnell GMR-270 Image Display System. C C Device type code: /GRINNELL. C C Default device name: TV_DEVICE (a logical name, usually C defined by the system manager). C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 512 x 512 pixels. C C Color capability: Color indices 0-255 are supported. The C representation of all color indices can be changed. C C Input capability: The graphics cursor is a white cross-hair. The C user positions the cursor using the arrow keys and PF1-PF4 keys on C his terminal keyboard (SYS$COMMAND). The arrow keys move the cursor in C the appropriate direction; the size of the step for each keystroke is C controlled by the PF1-PF4 keys: PF1 -> 1 pixel, PF2 -> 4 pixels, C PF3 -> 16 pixels, PF4 -> 64 pixels. The user indicates that the C cursor has been positioned by typing any character other than an C arrow or PF1-PF4 key [control characters, eg, ctrl-C, and other C special characters should be avoided, as they may be intercepted by C the operating system]. C C File format: It is not possible to send Grinnell plots to a C disk file. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- INTEGER BUFSIZ PARAMETER (BUFSIZ=8192) INTEGER BUFFER INTEGER BUFLEV INTEGER UNIT, IER, I0, I1, J0, J1, IX, IY, ICH, L INTEGER GRGR00, GRGMEM, GRFMEM, SYS$DASSGN INTEGER SMG$CREATE_VIRTUAL_KEYBOARD INTEGER SMG$SET_KEYPAD_MODE INTEGER KBID LOGICAL APPEND, MONO CHARACTER*10 MSG INTEGER*2 GRNLBF(256), IC, IR, IG, IB, GCTABL(3,0:15), MONCOL INTEGER NW, IW DATA GCTABL /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ LOGICAL NEW, INIT SAVE NEW, INIT, MONO DATA INIT /.TRUE./ C----------------------------------------------------------------------- C C First call: determine type of Grinnell. C IF (INIT) THEN INIT = .FALSE. CALL GRGENV('GR_TYPE', MSG, L) NEW = (MSG(1:1).EQ.'P') C -- Phobos-type Grinnell (GR273) C -- otherwise Deimos-type Grinnell (GR270) CALL GRGENV('MONITOR', MSG, L) MONO = (MSG(1:1).EQ.'M' .OR. MSG(1:1).EQ.'m') C -- Monochrome monitor C -- otherwise color monitor IF (MONO) THEN DO IW=0,15 MONCOL = NINT(0.30*GCTABL(1,IW) + 0.59*GCTABL(2,IW) + 1 0.11*GCTABL(3,IW)) GCTABL(1,IW) = MONCOL GCTABL(2,IW) = MONCOL GCTABL(3,IW) = MONCOL END DO END IF END IF C C Branch on opcode. C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in GRINNELL device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = 'GRINNELL' LCHR = 8 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 511 RBUF(3) = 0 RBUF(4) = 511 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 50.0 RBUF(2) = 50.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'ICNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = 'TV_DEVICE' LCHR = 9 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 511 RBUF(3) = 0 RBUF(4) = 511 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE APPEND = RBUF(3).NE.0.0 C -- allocate buffer IER = GRGMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER RETURN END IF C -- open device IER = GRGR00(CHR, LCHR, UNIT) RBUF(1) = UNIT RBUF(2) = IER NBUF = 2 IF (IER.NE.1) THEN CALL GRFMEM(BUFSIZ, BUFFER) RETURN END IF IC = 1 C -- create a virtual keyboard for cursor control IER = SMG$CREATE_VIRTUAL_KEYBOARD(KBID, 'SYS$COMMAND') IER = SMG$SET_KEYPAD_MODE(KBID, 1) C -- skip initialization if "APPEND" requested IF (APPEND) RETURN C -- initialize device DO IW=1,256 GRNLBF(IW) = 'F000'X ! NOP (cancel byte mode) END DO CALL GRGR02(GRNLBF,256,%val(BUFFER),BUFLEV,UNIT) C IF (NEW) THEN GRNLBF(1) = 'A001'X ! SPD (image video driver) GRNLBF(2) = 'C000'X ! LPR0 (split/togg/crop/intr) GRNLBF(3) = 'C20F'X ! LPR1 (red overlays, cursors) GRNLBF(4) = 'C40F'X ! LPR2 (grn overlays, cursors) GRNLBF(5) = 'C60F'X ! LPR3 (blu overlays, cursors) GRNLBF(6) = 'C824'X ! LPR4 (video routing) GRNLBF(7) = 'CA00'X ! LPR5 (clamp, invert) C GRNLBF(8) = 'A002'X ! SPD (image function memory) GRNLBF(9) = 'C000'X ! LPR0 (split/toggle/retrace) GRNLBF(10) = 'C200'X ! LPR1 (input bits 8,9) GRNLBF(11) = 'C8E4'X ! LPR4 (lookup table routing) GRNLBF(12) = 'CA00'X ! LPR5 (bypass) NW = 12 ELSE GRNLBF(1) = 'A001'X ! SPD 1 (image function video) GRNLBF(2) = 'C800'X ! LPR4 (select ABC channels) GRNLBF(3) = 'CA00'X ! LPR5 (no bypass or invert) NW = 3 END IF CALL GRGR02(GRNLBF,NW,%val(BUFFER),BUFLEV,UNIT) C GRNLBF(1) = 'B000'X ! LPA (table A) (red) DO IW=0,15 GRNLBF(IW+2) = 'D000'X.OR.GCTABL(1,IW) END DO GRNLBF(18) = 'B400'X ! LPA (table B) (green) DO IW=0,15 GRNLBF(IW+19) = 'D000'X.OR.GCTABL(2,IW) END DO GRNLBF(35) = 'B800'X ! LPA (table C) (blue) DO IW=0,15 GRNLBF(IW+36) = 'D000'X.OR.GCTABL(3,IW) END DO NW = 51 CALL GRGR02(GRNLBF,NW,%val(BUFFER),BUFLEV,UNIT) C IF (NEW) THEN GRNLBF(1) = 'A100'X ! SPD (load PCR) GRNLBF(2) = 'C005'X ! LPR (PCR bits 0,2) GRNLBF(3) = 'A008'X ! SPD (zoom/pan) GRNLBF(4) = 'C000'X ! LPR GRNLBF(5) = 'B000'X ! LPA GRNLBF(6) = 'D0FF'X ! LPD GRNLBF(7) = 'D0FF'X ! LPD C GRNLBF(8) = 'A080'X ! SPD (quad cursor) GRNLBF(9) = 'C000'X ! LPR (all cursors off) C GRNLBF(10) = 'A000'X ! SPD (none) GRNLBF(11) = '800D'X ! LDC (channels 0,2,3) GRNLBF(12) = '2830'X ! LWM (R0,A0,Z1,V1,H0,W0) GRNLBF(13) = '1001'X ! LSM (color=1) NW =13 ELSE GRNLBF(1) = 'A008'X ! SPD 8 (zoom/pan) GRNLBF(2) = 'B000'X GRNLBF(3) = 'B000'X GRNLBF(4) = 'D000'X GRNLBF(5) = 'C004'X C GRNLBF(6) = 'A080'X ! SPD (quad cursor) GRNLBF(7) = 'C000'X ! LPR (all cursors off) C GRNLBF(8) = 'A000'X ! SPD (none) GRNLBF(9) = '8FFF'X ! LDC FFF GRNLBF(10) = '2830'X ! LWM (R0,A0,Z1,V1,H0,W0) GRNLBF(11) = '1001'X ! LSM (color=1) NW = 11 END IF GOTO 1000 C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE IER = SYS$DASSGN(%val(UNIT)) IF (IER.NE.1) THEN CALL GRWARN('Error closing graphics device.') CALL GRGMSG(IER) END IF IER = GRFMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRWARN('Error deallocating plot buffer.') CALL GRGMSG(IER) END IF C -- delete virtual keyboard IER = SMG$CREATE_VIRTUAL_KEYBOARD(KBID) RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE GRNLBF(1) = 'A000'X ! SPD 0 GRNLBF(2) = '1FFF'X ! LSM FFF GRNLBF(3) = '8FFF'X ! LDC FFF GRNLBF(4) = '2830'X ! LWM (R0,A0,Z1,V1,H0,W0) IF (APPEND) THEN GRNLBF(5) = '800D'X ! dummy ELSE GRNLBF(5) = '3000'X ! ERS END IF GRNLBF(6) = '800D'X ! LDC (channels 0,2,3) GRNLBF(7) = '1000'X .OR. IC ! LSM NW = 7 GOTO 1000 C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) CALL GRGR01(I0, J0, I1, J1, GRNLBF) NW = 4 GOTO 1000 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) CALL GRGR01(I0, J0, I0, J0, GRNLBF) NW = 4 GOTO 1000 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.255) THEN IC = 1 RBUF(1) = IC END IF GRNLBF(1) = '1000'X .OR. IC NW = 1 GOTO 1000 C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE CALL GRGR03(%val(BUFFER), UNIT, BUFLEV) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE C -- flush buffer CALL GRGR03(%val(BUFFER), UNIT, BUFLEV) C -- IX = NINT(RBUF(1)) IY = NINT(RBUF(2)) CALL GRGR04(IX, IY, ICH, IER, UNIT, KBID) IF (IER.EQ.1) THEN RBUF(1) = IX RBUF(2) = IY CHR = CHAR(ICH) ELSE CHR = CHAR(0) END IF NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IC = RBUF(1) IR = MIN(255.,MAX(RBUF(2)*255.,0.)) IG = MIN(255.,MAX(RBUF(3)*255.,0.)) IB = MIN(255.,MAX(RBUF(4)*255.,0.)) IF (MONO) THEN MONCOL = NINT(0.30*IR + 0.59*IG + 0.11*IB) IR = MONCOL IG = MONCOL IB = MONCOL END IF IF (NEW) THEN GRNLBF(1) = 'A002'X ! SPD 2 (image function video) ELSE GRNLBF(1) = 'A001'X ! SPD 1 (image function video) END IF GRNLBF(2) = 'B000'X .OR. IC ! LPA (table A) (red) GRNLBF(3) = 'D000'X .OR. IR GRNLBF(4) = 'B400'X .OR. IC ! LPA (table B) (green) GRNLBF(5) = 'D000'X .OR. IG GRNLBF(6) = 'B800'X .OR. IC ! LPA (table C) (blue) GRNLBF(7) = 'D000'X. OR. IB NW = 7 GOTO 1000 C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- Send the command. ------------------------------------------------- C 1000 CALL GRGR02(GRNLBF,NW,%val(BUFFER),BUFLEV,UNIT) C----------------------------------------------------------------------- END C*GRGR00 -- PGPLOT Grinnell driver, open device C+ INTEGER FUNCTION GRGR00 (GRFILE, GRFNLN, GRUNIT) CHARACTER*(*) GRFILE INTEGER GRFNLN, GRUNIT C C Returns: C GRGR00 : 1 if the device was opened successfully. Any C other value indicates that an error occurred. C Usually the value is the VMS error code. C C Arguments: C GRFILE (in/out) : requested device name (input); actual C device assigned (output). C GRFNLN (in/out) : length of device name. C GRUNIT (output) : channel assigned by VMS. C C Subroutines called: C GRWARN C GRGMSG C VMS system services C----------------------------------------------------------------------- INTEGER DVI$_DEVCLASS, DVI$_DEVNAM PARAMETER (DVI$_DEVCLASS=4) PARAMETER (DVI$_DEVNAM=32) INTEGER DEVCLASS, ITMLIST(7), IOSB(2) INTEGER IER, L, SYS$ASSIGN INTEGER SYS$GETDVI, SYS$DASSGN, SYS$WAITFR C C Assign an i/o channel. C L = GRFNLN IER = SYS$ASSIGN(GRFILE(1:L), GRUNIT,,) IF (.NOT.IER) GOTO 100 C C Check that device has correct characteristics, and obtain true C device name. C ITMLIST(1) = DVI$_DEVCLASS*2**16 + 4 ITMLIST(2) = %LOC(DEVCLASS) ITMLIST(3) = 0 ITMLIST(4) = DVI$_DEVNAM*2**16 + LEN(GRFILE) ITMLIST(5) = %LOC(GRFILE) ITMLIST(6) = %LOC(GRFNLN) ITMLIST(7) = 0 IER = SYS$GETDVI(%VAL(0),,GRFILE(1:GRFNLN), ITMLIST,IOSB,,,) IF (.NOT.IER) GOTO 100 IER = SYS$WAITFR(%VAL(0)) IF (.NOT.IER) GOTO 100 IF (.NOT.IOSB(1)) THEN IER = IOSB(1) GOTO 100 END IF IF (DEVCLASS.NE.32 .AND. DEVCLASS.NE.96) THEN CALL GRWARN( GRFILE(1:GRFNLN)// 2 ' is the wrong sort of device for plot type GRINNELL') GRGR00 = 32767 ! indicate error IER = SYS$DASSGN(%VAL(GRUNIT)) RETURN END IF C C Successful completion. C GRGR00 = 1 RETURN C C Error exit. C 100 CALL GRWARN('Cannot open graphics device '//GRFILE(1:L)) CALL GRGMSG(IER) GRGR00 = IER C----------------------------------------------------------------------- END C*GRGR01 -- PGPLOT Grinnell driver, line segment C+ SUBROUTINE GRGR01 (I0, J0, I1, J1, GRNLBF) INTEGER*2 I0, J0, I1, J1 INTEGER*2 GRNLBF(4) C C Arguments: C I0, J0 (input) : device coordinates of the starting point. C I1, J1 (input) : device coordinates of the end point. C GRNLBF (output) : buffer for instruction. C C Subroutines called: C GRGR02 C----------------------------------------------------------------------- INTEGER*2 IC0, JC0, IC1, JC1, DX, DY, T INTEGER*2 X, CLIP511 C CLIP511(X) = X .AND. '1FF'X C IC0 = CLIP511(I0) JC0 = CLIP511(J0) IC1 = CLIP511(I1) JC1 = CLIP511(J1) T = IC1-IC0 DX = CLIP511(T) T = JC1-JC0 DY = CLIP511(T) C C Assume Grinnell has already been initialized for vector drawing C (LWM) and SPD 0 has been selected, and appropriate channels have C been selected. C GRNLBF(1) = '4800'X .OR. IC0 ! LEA GRNLBF(2) = '5000'X .OR. DX ! LEB GRNLBF(3) = '6800'X .OR. JC0 ! LLA GRNLBF(4) = '7400'X .OR. DY ! LLB (W=1) C----------------------------------------------------------------------- END C*GRGR02 -- PGPLOT Grinnell driver, transfer data to buffer C+ SUBROUTINE GRGR02 (INSTR, N, BUFFER, HWM, UNIT) INTEGER N, HWM, UNIT INTEGER*2 INSTR(*), BUFFER(*) C C Arguments: C INSTR (input) : text of instruction (16-bit words). C N (input) : number of 16-bit words to transfer. C BUFFER (input) : output buffer. C HWM (in/out) : number of bytes used in BUFFER. C UNIT (input) : channel number for output (when buffer is full). C C Subroutines called: C GRGR03 C----------------------------------------------------------------------- INTEGER BUFSIZ PARAMETER (BUFSIZ=8192) INTEGER I C----------------------------------------------------------------------- DO 10 I=1,N IF (HWM.GE.BUFSIZ) CALL GRGR03(BUFFER, UNIT, HWM) HWM = HWM + 2 BUFFER(HWM/2) = INSTR(I) 10 CONTINUE C----------------------------------------------------------------------- END C*GRGR03 -- PGPLOT Grinnell driver, copy buffer to device C+ SUBROUTINE GRGR03 (BUFFER, UNIT, N) BYTE BUFFER(*) INTEGER UNIT, N C C Arguments: C BUFFER (input) address of buffer to be output C UNIT (input) channel number for output C N (input) number of bytes to transfer C (output) set to zero C----------------------------------------------------------------------- INCLUDE '($IODEF)' C INTEGER SYS$QIOW C INTEGER RESULT INTEGER IOSB(2) INTEGER*2 STBC(2), STATUS, COUNT EQUIVALENCE (STBC, IOSB(1)), (STATUS, STBC(1)), (COUNT, STBC(2)) C----------------------------------------------------------------------- IF (N.LT.1) RETURN RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_WRITEVBLK.OR.IO$M_SETFNCT),IOSB,, 2 ,BUFFER,%VAL(N),,%VAL(0),,) IF (RESULT.NE.1) THEN CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW failure writing to Grinnell') END IF IF (STATUS.NE.1) THEN RESULT = STATUS CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW failure writing to Grinnell') END IF N = 0 C----------------------------------------------------------------------- END C*GRGR04 -- PGPLOT Grinnell driver, cursor routine C+ SUBROUTINE GRGR04 (IX, IY, IC, IER, UNIT, KBID) INTEGER IX, IY, IC, IER, UNIT, KBID C C Arguments: C IX, IY (in/out) : initial/final coordinates of cursor (device C coordinates). C IC (output) : character code. C IER (output) : error status (1 => OK). C UNIT (input) : channel for output to device. C KBID (input) : SMG keyboard identifier for control. C C This version uses the cursor on the zoom-pan card (peripheral C device bit 3). The cursor is moved by using the arrow keys on the C terminal; the cursor "speed" (step size) is controlled by the C PF1 (smallest step) to PF4 (largest step) keys. The numeric keys C on the keypad can be used in place of the arrow keys, with the C addition of diagonal motion: C ^ C 7 8 9 C < 4 6 > C 1 2 3 C v C C The user indicates that the cursor has been positioned by C typing any character on his keyboard (SYS$COMMAND), with the C following exceptions: control characters (^C, ^O, ^Q, ^R, ^S, C ^T, ^U, ^X, ^Y, DEL) are intercepted by the operating system C and cannot be used; NUL, ESC (^[) and escape sequences (e.g., C arrow keys) are ignored by GRCURS. C----------------------------------------------------------------------- INTEGER*2 GRNLBF(5),IXG,IYG INTEGER SMG$READ_KEYSTROKE INTEGER STEP, NBYTES DATA STEP/4/ ! initial step size C----------------------------------------------------------------------- 10 IXG = IX IYG = IY GRNLBF(1) = 'A008'X ! SPD ZOOM/PAN GRNLBF(2) = 'C020'X ! enable cursor GRNLBF(3) = 'B000'X ! LPA 0 GRNLBF(4) = 'D000'X .OR. IXG ! load X coord GRNLBF(5) = 'D000'X .OR. IYG ! load Y coord NBYTES = 10 CALL GRGR03(GRNLBF,UNIT,NBYTES) IER = SMG$READ_KEYSTROKE(KBID, IC) IF (IER.NE.1) RETURN IF (IC.EQ.274 .OR. IC.EQ.268) THEN C key UP or KP8 IY = MIN(511,IY+STEP) ELSE IF (IC.EQ.275 .OR. IC.EQ.262) THEN C key DOWN or KP2 IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.276 .OR. IC.EQ.264) THEN C key LEFT or KP4 IX = MAX(0,IX-STEP) ELSE IF (IC.EQ.277 .OR. IC.EQ.266) THEN C key RIGHT or KP6 IX = MIN(511,IX+STEP) ELSE IF (IC.EQ.267) THEN C key KP7 IX = MAX(0,IX-STEP) IY = MIN(511,IY+STEP) ELSE IF (IC.EQ.269) THEN C key KP9 IX = MIN(511,IX+STEP) IY = MIN(511,IY+STEP) ELSE IF (IC.EQ.263) THEN C key KP3 IX = MIN(511,IX+STEP) IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.261) THEN C key KP1 IX = MAX(0,IX-STEP) IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.265) THEN C key KP5 ("home") IX = 255 IY = 255 ELSE IF (IC.EQ.256) THEN C key PF1 or KP4 STEP = 1 ELSE IF (IC.EQ.257) THEN C key PF2 STEP = 4 ELSE IF (IC.EQ.258) THEN C key PF3 STEP = 16 ELSE IF (IC.EQ.259) THEN C key PF4 STEP = 64 END IF IF (IC.LE.0 .OR. IC.GT.255) GOTO 10 GRNLBF(1) = 'A008'X GRNLBF(2) = 'C000'X ! disable all cursors GRNLBF(3) = 'A000'X NBYTES = 6 CALL GRGR03(GRNLBF,UNIT,NBYTES) C----------------------------------------------------------------------- END F(4)*255.,0.)) IF (MONO) THEN MONCOL = NINT(0.30*IR + 0.59*IG + 0.11*IB) IR = MONCOL IG = MONCOL IB = MONCOL END IF IF (NEW) THEN GRNLBF(1) = 'A002'X ! SPD 2 (image fpgplot/drivers/old/pkdriv.f010064400040640000322000000530760552456011400164510ustar00tjpcitmbr00000400000017C*PKDRIV -- PGPLOT Peritek VCK-Q 1024 driver C+ SUBROUTINE PKDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Peritek Corp. VCH-Q display C C Version .96 - 1989 Mar 30 - Christopher K. Lee / T. J. Pearson. C Version .97 - 1989 Jul 14 - color/monochrome monitors. C C C Supported device: Peritek Corp. VCK-Q frame-buffer video C interface with HD63484 ACRTC, using a custom VMS device driver. C (Peritek Corp., 5550 Redwood Rd., Oakland, CA 94619, 415-531-6500) C C Device type code: /PK. C C Default device name: PKA0: C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 1024 x 1024 pixels. C C Color capability: Color indices 0-255 are supported. The C representation of all color indices can be changed. Define C PGPLOT_MONITOR = MONOCHROME to use a monochrome monitor: colors C are then converted to shades of gray. C C Input capability: The graphics cursor is a white cross-hair. The C user positions the cursor using the arrow keys and PF1-PF4 keys on C his terminal keyboard (SYS$COMMAND). The arrow keys move the cursor in C the appropriate direction; the size of the step for each keystroke is C controlled by the PF1-PF4 keys: PF1 -> 1 pixel, PF2 -> 4 pixels, C PF3 -> 16 pixels, PF4 -> 64 pixels. The user indicates that the C cursor has been positioned by typing any character other than an C arrow or PF1-PF4 key [control characters, eg, ctrl-C, and other C special characters should be avoided, as they may be intercepted by C the operating system]. C C File format: It is not possible to send Peritek VCK-Q plots to a C disk file. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='PK (Peritek Image Display)') INTEGER UNIT, I, IER, I0, I1, J0, J1, IX, IY, ICH, L LOGICAL APPEND, MONO CHARACTER*10 MSG INTEGER*2 IC, IR, IG, IB, LOC(2), KWORD INTEGER GRPK00, SYS$DASSGN BYTE PXLINE(1024), KBYTE EQUIVALENCE (KBYTE, KWORD) C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in PK device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 1023 RBUF(3) = 0 RBUF(4) = 1023 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 100. RBUF(2) = 100. RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area fill, C no thick lines, no rectangle fill, pixel) C 40 CHR = 'ICNNNNPNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = 'PKA0:' LCHR = 5 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 1023 RBUF(3) = 0 RBUF(4) = 1023 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- Monochrome monitor? CALL GRGENV('MONITOR', MSG, L) MONO = (MSG(1:1).EQ.'M' .OR. MSG(1:1).EQ.'m') C -- Append flag? APPEND = RBUF(3).NE.0.0 C -- Open device IER = GRPK00(CHR, LCHR, UNIT) RBUF(1) = UNIT RBUF(2) = IER NBUF = 2 IF (IER.NE.1) RETURN IC = 1 C -- skip initialization if "APPEND" requested IF (APPEND) RETURN CALL GRPK03(UNIT,MONO) C CALL GRPK04(2,UNIT) RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE IER = SYS$DASSGN(%val(UNIT)) IF (IER.NE.1) THEN CALL GRWARN('Error closing graphics device.') CALL GRGMSG(IER) END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE IF (.NOT.APPEND) CALL GRPK04(2, UNIT) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) CALL GRPK01(I0, J0, I1, J1, IC, UNIT) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) CALL GRPK07(I0, J0, IC, UNIT) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C IF (RBUF(1).NE.0.) CALL GRPK04(2,UNIT) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.255) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE IX = NINT(RBUF(1)) IY = NINT(RBUF(2)) CALL GRPK05(IX, IY, ICH, IER, UNIT) IF (IER.EQ.1) THEN RBUF(1) = IX RBUF(2) = IY CHR = CHAR(ICH) ELSE CHR = CHAR(0) END IF NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE CALL GRPK04(1,UNIT) RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE ICH = RBUF(1) IR = MIN(255.,MAX(RBUF(2)*255.,0.)) IG = MIN(255.,MAX(RBUF(3)*255.,0.)) IB = MIN(255.,MAX(RBUF(4)*255.,0.)) CALL GRPK08 (ICH,IR,IG,IB,UNIT,MONO) C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE RETURN C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill ------------------------------------------ C (Not implemented: ignored) C 240 CONTINUE RETURN C C--- IFUNC=25, --------------------------------------------------------- C (Not implemented: ignored) C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE LOC(2) = NINT(RBUF(1)) LOC(1) = NINT(RBUF(2)) DO 261 I=1,NBUF-2 KWORD = RBUF(I+2) PXLINE(I) = KBYTE 261 CONTINUE CALL GRPK02(4, NBUF-2, PXLINE, LOC, UNIT) RETURN C----------------------------------------------------------------------- END C*GRPK00 -- PGPLOT Peritek VCK-Q driver, open device C+ INTEGER FUNCTION GRPK00 (GRFILE, GRFNLN, GRUNIT) CHARACTER*(*) GRFILE INTEGER GRFNLN, GRUNIT C C Returns: C GRPK00 : 1 if the device was opened successfully. Any C other value indicates that an error occurred. C Usually the value is the VMS error code. C C Arguments: C GRFILE (in/out) : requested device name (input); actual C device assigned (output). C GRFNLN (in/out) : length of device name. C GRUNIT (output) : channel assigned by VMS. C C Subroutines called: C GRWARN C GRGMSG C VMS system services C----------------------------------------------------------------------- INTEGER DVI$_DEVCLASS, DVI$_DEVNAM PARAMETER (DVI$_DEVCLASS=4) PARAMETER (DVI$_DEVNAM=32) INTEGER DEVCLASS, ITMLIST(7), IOSB(2) INTEGER IER, L, SYS$ASSIGN INTEGER SYS$GETDVI, SYS$DASSGN, SYS$WAITFR C C Assign an i/o channel. C L = GRFNLN IER = SYS$ASSIGN(GRFILE(1:L), GRUNIT,,) IF (IER.NE.1) GOTO 100 C C Check that device has correct characteristics, and obtain true C device name. C ITMLIST(1) = DVI$_DEVCLASS*2**16 + 4 ITMLIST(2) = %LOC(DEVCLASS) ITMLIST(3) = 0 ITMLIST(4) = DVI$_DEVNAM*2**16 + LEN(GRFILE) ITMLIST(5) = %LOC(GRFILE) ITMLIST(6) = %LOC(GRFNLN) ITMLIST(7) = 0 IER = SYS$GETDVI(%VAL(0),,GRFILE(1:GRFNLN), ITMLIST,IOSB,,,) IF (.NOT.IER) GOTO 100 IER = SYS$WAITFR(%VAL(0)) IF (.NOT.IER) GOTO 100 IF (.NOT.IOSB(1)) THEN IER = IOSB(1) GOTO 100 END IF IF (DEVCLASS.NE.32 .AND. DEVCLASS.NE.96) THEN CALL GRWARN( GRFILE(1:GRFNLN)// 2 ' is the wrong sort of device for plot type PK') GRPK00 = 32767 ! indicate error IER = SYS$DASSGN(%VAL(GRUNIT)) RETURN END IF C C Successful completion. C GRPK00 = 1 RETURN C C Error exit. C 100 CALL GRWARN('Cannot open graphics device '//GRFILE(1:L)) CALL GRGMSG(IER) GRPK00 = IER C----------------------------------------------------------------------- END C*GRPK01 -- PGPLOT Peritek VCK-Q driver, draw line segment C+ SUBROUTINE GRPK01 (ELEM1,LINE1,ELEM2,LINE2,CI,UNIT) INTEGER*2 ELEM1, ELEM2, LINE1, LINE2, CI INTEGER*4 UNIT C C ELEM1 I*4 start element C LINE1 I*4 start line C ELEM2 I*4 stop element C LINE2 I*4 stop line C CI I*2 color index to be used C UNIT I*4 unit number for output C C Note: the arguments are specified as integer*2, but (on the VAX at C least) integer*4 values may be used. The values should be in the C range defined by the hardware: (0...1023). C C (20-Oct-1987) C----------------------------------------------------------------------- INTEGER*2 DATA INTEGER*2 I1, J1, I2, J2 INTEGER*2 BUF(11),LOC(2) C DATA = CI I1 = ELEM1 J1 = LINE1 I2 = ELEM2 J2 = LINE2 BUF(1)= '4000'O ! Write Parameter register 0 or COL0 BUF(2)= DATA + ISHFT(DATA,8) BUF(3)= '4001'O ! Write Parameter register 1 or COL1 BUF(4)= BUF(2) BUF(5)= '100000'O ! AMOVE BUF(6)= I1 BUF(7)= J1 BUF(8)= '104000'O ! ALINE BUF(9)= I2 BUF(10)= J2 BUF(11)= '146000'O ! DOT CALL GRPK02(1,11,BUF,LOC,UNIT) C END C*GRPK02 -- PGPLOT Peritek VCK-Q driver, input/output data C+ SUBROUTINE GRPK02 (INOUT,N,BUFFER,LOC,UNIT) INTEGER INOUT, N, UNIT, LOC BYTE BUFFER(*) C C Arguments: C C INOUT (input) : 0 => read from frame buffer, C 1 => write to graphics chip, C 2 => erase alpha screen, C 3 => erase primary screen C 4 => write to frame buffer C N (integer, input): the number of bytes or words to transfer. C BUFFER (byte array, dimension at least N, input): the data C bytes to be put in the output buffer. C LOC (integer*2 array): Line # and element # to read from/write to C UNIT (input): channel number for output C C (20-Oct-1987) C----------------------------------------------------------------------- INCLUDE '($IODEF)' C INTEGER SYS$QIOW, RESULT, IOSB(2) INTEGER*2 STBC(2), STATUS, COUNT EQUIVALENCE (STBC, IOSB(1)), (STATUS, STBC(1)), (COUNT, STBC(2)) C IF (N.LT.1) RETURN IF (INOUT.EQ.0) THEN C Read from Frame Buffer RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_READVBLK),IOSB,,, 2 %VAL(2),BUFFER,%VAL(N),%VAL(LOC),,) ELSE IF (INOUT.EQ.1) THEN C Write to ACRTC FIFO register list RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_WRITEVBLK),IOSB,,, 2 %VAL(2),BUFFER,%VAL(N),,,) ELSE IF (INOUT.EQ.2) THEN C Clear Alpha 0 Screen RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_MODIFY),IOSB,,, 2 %VAL(1),,,,,) ELSE IF (INOUT.EQ.3) THEN C Clear Primary Screen RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_MODIFY),IOSB,,, 2 %VAL(2),,,,,) ELSE IF (INOUT.EQ.4) THEN C Write to Frame Buffer RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_WRITEVBLK),IOSB,,, 2 %VAL(4),BUFFER,%VAL(N),%VAL(LOC),,) END IF IF (RESULT.NE.1) THEN CALL GRGMSG(RESULT) CALL GRQUIT('PK02A: SYS$QIO failure writing to TV') END IF IF (STATUS.NE.1) THEN RESULT = STATUS CALL GRGMSG(RESULT) CALL GRQUIT('PK02B: SYS$QIO failure writing to TV') END IF END C*GRPK03 -- PGPLOT Peritek VCK-Q driver, initialize color display C+ SUBROUTINE GRPK03 (UNIT,MONO) INTEGER UNIT LOGICAL MONO C C Initialize the color tables to standard values. C C (14-Jul-1989) C----------------------------------------------------------------------- INTEGER*2 I, GCTABL(3,16) DATA GCTABL /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ C DO 20 I=1,16 CALL GRPK08(I-1, GCTABL(1,I), GCTABL(2,I), GCTABL(3,I), UNIT, 1 MONO) 20 CONTINUE END C*GRPK04 -- PGPLOT Peritek VCK-Q driver, clear screens C+ SUBROUTINE GRPK04 (ISCR,UNIT) INTEGER ISCR,UNIT C C Arguments: C ISCR (input) : 1 = clear alpha screen, 2 = clear primary screen C UNIT (input) : channel number for output C----------------------------------------------------------------------- INTEGER*2 BUF(4),LOC(2) C----------------------------------------------------------------------- IF (ISCR.EQ.1) THEN CALL GRPK02(2,4,BUF,LOC,UNIT) ELSE IF (ISCR.EQ.2) THEN CALL GRPK02(3,4,BUF,LOC,UNIT) END IF END C*GRPK05 -- PGPLOT Peritek VCK-Q driver, cursor routine C+ SUBROUTINE GRPK05 (IX, IY, IC, IER, UNIT) INTEGER IX, IY, IC, IER, UNIT C C Arguments: C IX, IY (in/out) : initial/final coordinates of cursor (device C coordinates). C IC (output) : character code. C IER (output) : error status (1 => OK). C UNIT (input) : channel for output to device. C C The Peritek device has no hardware cursor. The cursor has to be C emulated by writing into the image array, and to delete it the C former contents must be restored. The cursor is a 5x5 pixel array; C to avoid edge effects, it cannot be moved within 2 pixels of the C edge of the screen. C C The cursor is moved by using the arrow keys on the C terminal; the cursor "speed" (step size) is controlled by the C PF1 (smallest step) to PF4 (largest step) keys. C C The user indicates that the cursor has been positioned by C typing any character on his keyboard (SYS$COMMAND), with the C following exceptions: control characters (^C, ^O, ^Q, ^R, ^S, C ^T, ^U, ^X, ^Y, DEL) are intercepted by the operating system C and cannot be used; NUL, ESC (^[) and escape sequences (e.g., C arrow keys) are ignored. C C (20-Oct-1987) C----------------------------------------------------------------------- C CURSIZ is the size of the cursor array: must be odd INTEGER CURSIZ, CURCEN PARAMETER (CURSIZ=15, CURCEN=(CURSIZ+1)/2) INTEGER*2 IXG,IYG, LOC2(2) INTEGER GRGETC, SYS$ASSIGN, SYS$DASSGN INTEGER STEP, ICHAN, I, J DATA STEP/4/ ! initial step size BYTE CU1(CURSIZ,CURSIZ), CU2(CURSIZ,CURSIZ) C----------------------------------------------------------------------- IER = SYS$ASSIGN('SYS$COMMAND',ICHAN,,) IF (IER.NE.1) RETURN IX = MAX(CURCEN-1,MIN(IX,1023-CURCEN+1)) IY = MAX(CURCEN-1,MIN(IY,1023-CURCEN+1)) 10 IXG = IX IYG = IY C -- Make cursor visible LOC2(2) = IXG-CURCEN+1 DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPK02(0,CURSIZ,CU1(1,J),LOC2,UNIT) END DO DO I=1,CURSIZ DO J=1,CURSIZ CU2(I,J) = CU1(I,J) END DO END DO DO I=1,CURSIZ CU2(I,CURCEN) = 1 CU2(CURCEN,I) = 1 CU2(I,I) = 0 CU2(I,CURSIZ+1-I) = 0 END DO DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPK02(4,CURSIZ,CU2(1,J),LOC2,UNIT) END DO IC = GRGETC(ICHAN) IF (IC.EQ.-1) THEN IY = MIN(1023-CURCEN+1,IY+STEP) ELSE IF (IC.EQ.-2) THEN IY = MAX(CURCEN-1,IY-STEP) ELSE IF (IC.EQ.-3) THEN IX = MIN(1023-CURCEN+1,IX+STEP) ELSE IF (IC.EQ.-4) THEN IX = MAX(CURCEN-1,IX-STEP) ELSE IF (IC.EQ.-11) THEN STEP = 1 ELSE IF (IC.EQ.-12) THEN STEP = 4 ELSE IF (IC.EQ.-13) THEN STEP = 16 ELSE IF (IC.EQ.-14) THEN STEP = 64 END IF C --- Erase cursor by restoring former image contents DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPK02(4,CURSIZ,CU1(1,J),LOC2,UNIT) END DO IF (IC.LE.0 .OR. IC.GT.255) GOTO 10 IER = SYS$DASSGN(%VAL(ICHAN)) C----------------------------------------------------------------------- END C*GRPK07 -- PGPLOT Peritek VCK-Q driver, draw a dot C+ SUBROUTINE GRPK07 (ELEM1,LINE1,CI,UNIT) INTEGER*2 ELEM1, LINE1, CI INTEGER*4 UNIT C C ELEM1 I*4 dot element C LINE1 I*4 dot line C CI I*2 color index to be used C UNIT I*4 unit number for output C C Note: the arguments are specified as integer*2, but (on the VAX at C least) integer*4 values may be used. The values should be in the C range defined by the hardware: (0...1023). C C (20-Oct-1987) C----------------------------------------------------------------------- INTEGER*2 DATA INTEGER*2 I0, J0, BUF(8), LOC(2) C DATA = CI I0 = ELEM1 J0 = LINE1 BUF(1)= '4000'O ! Write Parameter Register 0 or COL0 BUF(2)= DATA + ISHFT(DATA,8) BUF(3)= '4001'O ! Write Parameter Register 1 or COL1 BUF(4)= BUF(2) BUF(5)= '100000'O ! AMOVE BUF(6)= I0 BUF(7)= J0 BUF(8)= '146000'O ! DOT CALL GRPK02(1,8,BUF,LOC,UNIT) C END C*GRPK08 -- PGPLOT Peritek VCK-Q driver, set color representation C+ SUBROUTINE GRPK08 (CIN,R,G,B,UNIT,MONO) INTEGER*2 CIN, R, G, B INTEGER UNIT LOGICAL MONO C C Arguments: C CIN I*2 LUT index 0 to 255 C R,G,B I*2 Color component 0 to 255 C UNIT I*4 Channel number for output C MONO L*4 If .TRUE., convert color to gray shade. C C (14-Jul-1989) C----------------------------------------------------------------------- INTEGER*2 MCLR(2), DATA C MCLR(1)=0 IF (MONO) THEN DATA = NINT(0.30*R+0.59*G+0.11*B) MCLR(2)=7 CALL GRPK09(1,DATA,1,CIN,MCLR,UNIT) ELSE DATA = R MCLR(2)=1 CALL GRPK09(1,DATA,1,CIN,MCLR,UNIT) DATA = G MCLR(2)=2 CALL GRPK09(1,DATA,1,CIN,MCLR,UNIT) DATA = B MCLR(2)=4 CALL GRPK09(1,DATA,1,CIN,MCLR,UNIT) END IF C END C*GRPK09 -- PGPLOT Peritek VCK-Q driver, input/output CMM data C+ SUBROUTINE GRPK09 (INOUT,BUFFER,N,ELEM,MCLR,UNIT) INTEGER INOUT, N, ELEM, UNIT, MCLR BYTE BUFFER(*) C C Arguments: C C INOUT (input) : 1 => write, 0 => read C N (input) : # bytes to transfer C ELEM (input) : element to write to. C BUFFER (byte array, dimension at least N, input): the data C bytes to be put in the output buffer. C MCLR (integer*2 array): which map # and which color to modify C bit set 0=red, 1=green, 2=blue. C UNIT (input): channel number for output C C (20-Oct-1987) C----------------------------------------------------------------------- INCLUDE '($IODEF)' C INTEGER SYS$QIOW, RESULT, IOSB(2), LOC INTEGER*2 STBC(2), STATUS, COUNT, WORD(2) EQUIVALENCE (STBC, IOSB(1)), (STATUS, STBC(1)), (COUNT, STBC(2)) EQUIVALENCE (LOC,WORD(1)) C IF (N.LT.1) RETURN IF (INOUT.EQ.1) THEN WORD(1)=N WORD(2)=ELEM RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_WRITEVBLK),IOSB,,, 2 %VAL(3),BUFFER,%VAL(LOC),%VAL(MCLR),,) ELSE STATUS = 1 RESULT = 1 END IF IF (RESULT.NE.1) THEN CALL GRGMSG(RESULT) CALL GRQUIT('PK09A: SYS$QIO failure writing to TV') END IF IF (STATUS.NE.1) THEN RESULT = STATUS CALL GRGMSG(RESULT) CALL GRQUIT('PK09B: SYS$QIO failure writing to TV') END IF END 3 => erase primary screen C 4 => write to frame buffer C N (integer, input): the number of bytes or words to transfer. C BUFFER (byte array, dimension at least N, input): the data C bytes to be put in the output buffer. C LOC (integer*2 array): Line # and element # to read from/write to C UNIT (input): channel number for output C C (20-Oct-1987) C----------------------------------------------------------------------- pgplot/drivers/old/pzdriv.f010064400040640000322000000567410563041631700164750ustar00tjpcitmbr00000400000017C*PZDRIV -- PGPLOT Peritek driver C+ SUBROUTINE PZDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Peritek Corp. VCH-Q display C C Version 1.0 - 1987 May 26 - T. J. Pearson. C Version 1.1 - 1987 Jun 4 - add cursor support (TJP). C Version 1.2 - 1987 Jul 1 - larger cursor (TJP). C C C Supported device: Peritek Corp. VCH-Q frame-buffer video C interface with HD6845 CRTC, using a custom VMS device driver. C (Peritek Corp., 5550 Redwood Rd., Oakland, CA 94619, 415-531-6500) C C Device type code: /PERITEK. C C Default device name: TV_DEVICE (a logical name, usually C defined by the system manager). C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 512 x 512 pixels. C C Color capability: Color indices 0-255 are supported. The C representation of all color indices can be changed. As the C device is normally connected to a monochrome monitor, all C colors are converted to grayscale by averaging the R, G, B C components. C C Input capability: Not implemented. C C File format: It is not possible to send plots to a disk file. C C Obtaining hardcopy: Not possible. C C----------------------------------------------------------------------- C The driver makes use of the following PGPLOT support routines: C GRGETC C GRGMSG C GRQUIT C GRWARN C----------------------------------------------------------------------- * The following notes describe the VMS device-driver interface used * with this device. The QIO functions supported are: * * IO$_WRITEVBLK - write virtual block, * IO$_READVBLK - read virtual block, * IO$_MODIFY - set display mode, * IO$_ACCESS - write block of x,y,z values. * * IO$_WRITEVBLK: Consecutive bytes (8 bits) of data are transferred * from a user specified buffer to consecutively addressed elements in * either the graphics display memory or the color map memory of the * VCH-Q, starting at a specified element. The required device * specific QIO parameters are: * * P1 - the address of the data buffer; * P2 - the number of bytes of data to be transferred; * P3 - a longword containing the initial line number in * its least significant word and the initial element * number in its most significant word. * * A write operation to the graphics display memory is signalled by an * initial line number that is non-negative. In this case the effective * initial line number and the effective initial element number are * calculated from the values, line0 and elem0, in P3 as follows: * * initial line = (line0 + (elem0 / 512)) modulo 512, and * initial element = elem0 modulo 512. * * Line number 0 refers to the bottom line of the display and line * number 511 refers to the top line. Element number 0 corresponds to * the leftmost element of the line and element number 511, the * rightmost. The data are written to memory elements consecutively * addressed by incrementing the element number modulo 512 with * wrap-around to element 0 of the next higher line number modulo 512. * * A write operation to the color map memory is signalled by an initial * line number that is negative. The value of the initial line number * selects which of the color maps are to be written: * * - 1: bottom red, * - 2: bottom green, * - 4: bottom blue, * - 8: top red, * -16: top green, and * -32: top blue. * * Several of the color maps may be selected in a write operation by * giving an initial line number which is the sum of the values, above, * for the individual desired maps. The elements of a color map are * numbered from 0 to 255 and the given initial element number and the * value of the P2 parameter must not be such as to write past the end * of the map (element 255). * * IO$_READVBLK: Except that the direction of data transfer is * reversed, the same description applies as is given above for the * write function but with one other difference: only one color map * may be selected at a time in a read. * * IO$_MODIFY: The required device specific QIO parameter is: * * P1 - a longword parameter consisting of two packed word- * length booleans: bit 0, use the top mapbit 16, * interpixellate the display. The bit values are * 0: false, 1: true. * * IO$_ACCESS: used to modify individual bits in individual pixels in * the image memory. The required device specific QIO parameters are: * * P1 - a longword that is the start of a data buffer * P2 - the length of the data buffer in bytes * * The data buffer is organized in groups of 8 byte records. Each 8 * byte record specifies one location in the VCH-Q image memory that is * to be modified. It also specifies which of the 8 bits to modify in * that location. The format of a record is 4 16-bit integers organized * in the following way: * * _________ * | | element within a line, modulo 512 ( x ) * --------- * | | line number, modulo 512 ( y ) * --------- * | | bit pattern to use, modulo 256 ( z ) * --------- * | | bit pattern modification mask, modulo 256 * --------- * * The bit modification mask determines which bits are to be changed in * the specified location of the image memory. A 1 in a bit in the mask * indicates that the final value of a bit in memory should be taken * from the value in bit pattern word of the record. A 0 in a bit in * the mask indicates that the final value of a bit in memory should be * the value already in memory. For example, a modification mask of all * 1's tells the driver to replace the value in memory with the bit * pattern in the record, whereas a mask of all 0's tells the driver to * leave the memory alone. C----------------------------------------------------------------------- INTEGER UNIT, IER, I0, I1, J0, J1, IX, IY, ICH LOGICAL APPEND CHARACTER*10 MSG INTEGER*2 IC, IR, IG, IB INTEGER GRPZ00, SYS$DASSGN C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in PERITEK device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = 'PERITEK' LCHR = 7 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 511 RBUF(3) = 0 RBUF(4) = 511 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 50.0 RBUF(2) = 50.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area C fill, No thick lines) C 40 CHR = 'ICNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = 'TV_DEVICE' LCHR = 9 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 511 RBUF(3) = 0 RBUF(4) = 511 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE APPEND = RBUF(3).NE.0.0 IER = GRPZ00(CHR, LCHR, UNIT) RBUF(1) = UNIT RBUF(2) = IER NBUF = 2 IC = 1 C -- skip initialization if "APPEND" requested IF (APPEND) RETURN CALL GRPZ05(UNIT) RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE IER = SYS$DASSGN(%val(UNIT)) IF (IER.NE.1) THEN CALL GRWARN('Error closing graphics device') CALL GRGMSG(IER) END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE IF (.NOT.APPEND) CALL GRPZ04(UNIT) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) CALL GRPZ01 (I0, J0, I1, J1, IC, UNIT) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) CALL GRPZ01 (I0, J0, I0, J0, IC, UNIT) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.255) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE IX = NINT(RBUF(1)) IY = NINT(RBUF(2)) CALL GRPZ06(IX, IY, ICH, IER, UNIT) IF (IER.EQ.1) THEN RBUF(1) = IX RBUF(2) = IY CHR = CHAR(ICH) ELSE CHR = CHAR(0) END IF NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE ICH = RBUF(1) IR = MIN(255.,MAX(RBUF(2)*255.,0.)) IG = MIN(255.,MAX(RBUF(3)*255.,0.)) IB = MIN(255.,MAX(RBUF(4)*255.,0.)) CALL GRPZ03 (ICH,IR,IG,IB,UNIT) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRPZ00 -- PGPLOT Peritek driver, open device C+ INTEGER FUNCTION GRPZ00 (GRFILE, GRFNLN, GRUNIT) CHARACTER*(*) GRFILE INTEGER GRFNLN, GRUNIT C C Returns: C GRPZ00 : 1 if the device was opened successfully. Any C other value indicates that an error occurred. C Usually the value is the VMS error code. C C Arguments: C GRFILE (in/out) : requested device name (input); actual C device assigned (output). C GRFNLN (in/out) : length of device name. C GRUNIT (output) : channel assigned by VMS. C C Subroutines called: C GRWARN C GRGMSG C VMS system services C----------------------------------------------------------------------- INTEGER DVI$_DEVCLASS, DVI$_DEVNAM PARAMETER (DVI$_DEVCLASS=4) PARAMETER (DVI$_DEVNAM=32) INTEGER DEVCLASS, ITMLIST(7), IOSB(2) INTEGER IER, L, SYS$ASSIGN INTEGER SYS$GETDVI, SYS$DASSGN, SYS$WAITFR C C Assign an i/o channel. C L = GRFNLN IER = SYS$ASSIGN(GRFILE(1:L), GRUNIT,,) IF (.NOT.IER) GOTO 100 C C Check that device has correct characteristics, and obtain true C device name. C ITMLIST(1) = DVI$_DEVCLASS*2**16 + 4 ITMLIST(2) = %LOC(DEVCLASS) ITMLIST(3) = 0 ITMLIST(4) = DVI$_DEVNAM*2**16 + LEN(GRFILE) ITMLIST(5) = %LOC(GRFILE) ITMLIST(6) = %LOC(GRFNLN) ITMLIST(7) = 0 IER = SYS$GETDVI(%VAL(0),,GRFILE(1:GRFNLN), ITMLIST,IOSB,,,) IF (.NOT.IER) GOTO 100 IER = SYS$WAITFR(%VAL(0)) IF (.NOT.IER) GOTO 100 IF (.NOT.IOSB(1)) THEN IER = IOSB(1) GOTO 100 END IF IF (DEVCLASS.NE.32 .AND. DEVCLASS.NE.96) THEN CALL GRWARN( GRFILE(1:GRFNLN)// 2 ' is the wrong sort of device for plot type PERITEK') GRPZ00 = 32767 ! indicate error IER = SYS$DASSGN(%VAL(GRUNIT)) RETURN END IF C C Successful completion. C GRPZ00 = 1 RETURN C C Error exit. C 100 CALL GRWARN('Cannot open graphics device '//GRFILE(1:L)) CALL GRGMSG(IER) GRPZ00 = IER C----------------------------------------------------------------------- END C*GRPZ01 -- PGPLOT Peritek driver, draw line segment C+ SUBROUTINE GRPZ01 (ELEM1,LINE1,ELEM2,LINE2,CI,UNIT) INTEGER*2 ELEM1, ELEM2, LINE1, LINE2, CI INTEGER*4 UNIT C C ELEM1 I*4 start element C LINE1 I*4 start line C ELEM2 I*4 stop element C LINE2 I*4 stop line C CI I*2 color index to be used C UNIT I*4 unit number for output C C Note: the arguments are specified as integer*2, but (on the VAX at C least) integer*4 values may be used. The values should be in the C range defined by the hardware: (0...511). C C (28-May-1987) C----------------------------------------------------------------------- BYTE DATA REAL*4 SLOPE, DELEM, DLINE INTEGER*2 LOC(2) INTEGER*2 I1, J1, I2, J2, STEP INTEGER I, J, N BYTE BUF(512) C DATA = CI I1 = ELEM1 J1 = LINE1 I2 = ELEM2 J2 = LINE2 DLINE = J2-J1 DELEM = I2-I1 SLOPE = 1.0E10 C IF (DELEM .NE. 0) SLOPE = DLINE/DELEM IF (DLINE.EQ.0) THEN LOC(2) = MIN(I1,I2) LOC(1) = J1 N = ABS(I1-I2)+1 DO 5 I=1,N BUF(I) = DATA 5 CONTINUE CALL GRPZ02(1,N,BUF,LOC,UNIT) ELSE IF (ABS(SLOPE) .LT. 1.0) THEN STEP = IISIGN(1,(I2-I1)) DO 10 I = I1, I2, STEP LOC(2) = I LOC(1) = (LOC(2)-I1)*SLOPE + J1 CALL GRPZ02(1,1,DATA,LOC,UNIT) 10 CONTINUE C ELSE IF (DLINE .NE. 0) THEN SLOPE = DELEM/DLINE STEP = IISIGN(1,(J2-J1)) DO 20 J = J1, J2, STEP LOC(1) = J LOC(2) = (LOC(1) - J1)*SLOPE + I1 CALL GRPZ02(1,1,DATA,LOC,UNIT) 20 CONTINUE C ELSE LOC(1) = J1 LOC(2) = I1 CALL GRPZ02(1,1,DATA,LOC,UNIT) END IF END C*GRPZ02 -- PGPLOT Peritek driver, input/output data C+ SUBROUTINE GRPZ02 (INOUT,N,BUFFER,LOC,UNIT) INTEGER INOUT, N, UNIT BYTE BUFFER(*) INTEGER*4 LOC C C Arguments: C C INOUT (input) : 1 => write, 0 => read C N (integer, input): the number of bytes to transfer. C BUFFER (byte array, dimension at least N, input): the data C bytes to be put in the output buffer. C LOC (integer*2 array, dimension 2): location of the beginning C of the string of N data points. (I,J) C UNIT (input): channel number for output C C (28-May-1987) C----------------------------------------------------------------------- INCLUDE '($IODEF)' C INTEGER SYS$QIOW, RESULT, IOSB(2) INTEGER*2 STBC(2), STATUS, COUNT EQUIVALENCE (STBC, IOSB(1)), (STATUS, STBC(1)), (COUNT, STBC(2)) C IF (N.LT.1) RETURN IF (INOUT.EQ.1) THEN RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_WRITEVBLK),IOSB,,, 2 BUFFER,%VAL(N),%VAL(LOC),,,) ELSE RESULT = SYS$QIOW(,%VAL(UNIT), 1 %VAL(IO$_READVBLK),IOSB,,, 2 BUFFER,%VAL(N),%VAL(LOC),,,) END IF IF (RESULT.NE.1) THEN CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIO failure writing to TV') END IF IF (STATUS.NE.1) THEN RESULT = STATUS CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIO failure writing to TV') END IF END C*GRPZ03 -- PGPLOT Peritek driver, set color representation C+ SUBROUTINE GRPZ03 (CIN,R,G,B,UNIT) INTEGER*2 CIN, R, G, B INTEGER UNIT C C Arguments: C CIN I*2 LUT index 0 to 255 C R,G,B I*2 Color component 0 to 255 C UNIT I*4 Channel number for output C C *** NB *** This converts requested color index to monochrome shade C as all known installations of this device have monochrome monitors C C (28-May-1987) C----------------------------------------------------------------------- INTEGER*2 LOC2(2), MONO C MONO = NINT((R+G+B)/3.0) C LOC2(2) = CIN LOC2(1) = -1 CALL GRPZ02(1,1,MONO,LOC2,UNIT) C LOC2(1) = -2 CALL GRPZ02(1,1,MONO,LOC2,UNIT) C LOC2(1) = -4 CALL GRPZ02(1,1,MONO,LOC2,UNIT) C END C*GRPZ04 -- PGPLOT Peritek driver, clear screen C+ SUBROUTINE GRPZ04(UNIT) INTEGER UNIT C C Clears the tv by setting all pixel values to 0. C C (7-Jun-1987) C----------------------------------------------------------------------- INTEGER*4 BUF(128), J INTEGER*2 LOC(2) DATA BUF/128*0/ C LOC(2) = 0 C C Zero array. C DO 20 J=0,511 LOC(1) = J CALL GRPZ02(1,512,BUF,LOC,UNIT) 20 CONTINUE END C*GRPZ05 -- PGPLOT Peritek driver, initialize display C+ SUBROUTINE GRPZ05 (UNIT) INTEGER UNIT C C Initialize the display. Note that the screen is C NOT erased. The color tables are initialized as follows: C C Index Name (H,L,S) (R,G,B) C C 0 Black 0, 0.0, 0.0 0.0, 0.0, 0.0 C 1 White 0, 1.0, 0.0 1.0, 1.0, 1.0 C 2 Red 120, 0.5, 1.0 1.0, 0.0, 0.0 C 3 Green 240, 0.5, 1.0 0.0, 1.0, 0.0 C 4 Blue 0, 0.5, 1.0 0.0, 0.0, 1.0 C 5 Cyan (Green+Blue) 300, 0.5, 1.0 0.0, 1.0, 1.0 C 6 Magenta (Red+Blue) 60, 0.5, 1.0 1.0, 0.0, 1.0 C 7 Yellow (Red+Green) 180, 0.5, 1.0 1.0, 1.0, 0.0 C 8 Red+Yellow (Orange) 150, 0.5, 1.0 1.0, 0.5, 0.0 C 9 Green+Yellow 210, 0.5, 1.0 0.5, 1.0, 0.0 C 10 Green+Cyan 270, 0.5, 1.0 0.0, 1.0, 0.5 C 11 Blue+Cyan 330, 0.5, 1.0 0.0, 0.5, 1.0 C 12 Blue+Magenta 30, 0.5, 1.0 0.5, 0.0, 1.0 C 13 Red+Magenta 90, 0.5, 1.0 1.0, 0.0, 0.5 C 14 Dark Gray 0, .33, 0.0 .33, .33, .33 C 15 Light Gray 0, .66, 0.0 .66, .66, .66 C C (28-May-1987) C----------------------------------------------------------------------- BYTE LUT(256), LUT1 INTEGER*2 LUT2, LOC2(2), GCTABL(3,16) INTEGER*4 I C EQUIVALENCE (LUT1,LUT2) DATA GCTABL /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ C C INITIALIZE RED TABLE TO ABOVE LOC2(1) = -9 LOC2(2) = 0 DO 20 I=1,16 LUT2 = (GCTABL(1,I)+GCTABL(2,I)+GCTABL(3,I))/3 LUT(I) = LUT1 20 CONTINUE CALL GRPZ02(1,16,LUT,LOC2,UNIT) C INITIALIZE GREEN TABLE TO ABOVE LOC2(1) = -18 LOC2(2) = 0 DO 30 I=1,16 LUT2 = (GCTABL(1,I)+GCTABL(2,I)+GCTABL(3,I))/3 LUT(I) = LUT1 30 CONTINUE CALL GRPZ02(1,16,LUT,LOC2,UNIT) C INITIALIZE BLUE TABLE TO ABOVE LOC2(1) = -36 LOC2(2) = 0 DO 40 I=1,16 LUT2 = (GCTABL(1,I)+GCTABL(2,I)+GCTABL(3,I))/3 LUT(I) = LUT1 40 CONTINUE CALL GRPZ02(1,16,LUT,LOC2,UNIT) C END C*GRPZ06 -- PGPLOT Peritek driver, cursor routine C+ SUBROUTINE GRPZ06 (IX, IY, IC, IER, UNIT) INTEGER IX, IY, IC, IER, UNIT C C Arguments: C IX, IY (in/out) : initial/final coordinates of cursor (device C coordinates). C IC (output) : character code. C IER (output) : error status (1 => OK). C UNIT (input) : channel for output to device. C C The Peritek device has no hardware cursor. The cursor has to be C emulated by writing into the image array, and to delete it the C former contents must be restored. The cursor is a 5x5 pixel array; C to avoid edge effects, it cannot be moved within 2 pixels of the C edge of the screen. C C The cursor is moved by using the arrow keys on the C terminal; the cursor "speed" (step size) is controlled by the C PF1 (smallest step) to PF4 (largest step) keys. C C The user indicates that the cursor has been positioned by C typing any character on his keyboard (SYS$COMMAND), with the C following exceptions: control characters (^C, ^O, ^Q, ^R, ^S, C ^T, ^U, ^X, ^Y, DEL) are intercepted by the operating system C and cannot be used; NUL, ESC (^[) and escape sequences (e.g., C arrow keys) are ignored. C C (1-Jul-1987) C----------------------------------------------------------------------- C CURSIZ is the size of the cursor array: must be odd INTEGER CURSIZ, CURCEN PARAMETER (CURSIZ=9, CURCEN=(CURSIZ+1)/2) INTEGER*2 IXG,IYG, LOC2(2) INTEGER GRGETC, SYS$ASSIGN, SYS$DASSGN INTEGER STEP, ICHAN, I, J DATA STEP/4/ ! initial step size BYTE CU1(CURSIZ,CURSIZ), CU2(CURSIZ,CURSIZ) C----------------------------------------------------------------------- IER = SYS$ASSIGN('SYS$COMMAND',ICHAN,,) IF (IER.NE.1) RETURN IX = MAX(CURCEN-1,MIN(IX,511-CURCEN+1)) IY = MAX(CURCEN-1,MIN(IY,511-CURCEN+1)) 10 IXG = IX IYG = IY C -- Make cursor visible LOC2(2) = IXG-CURCEN+1 DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPZ02(0,CURSIZ,CU1(1,J),LOC2,UNIT) END DO DO I=1,CURSIZ DO J=1,CURSIZ CU2(I,J) = CU1(I,J) END DO END DO DO I=1,CURSIZ CU2(I,CURCEN) = 1 CU2(CURCEN,I) = 1 CU2(I,I) = 0 CU2(I,CURSIZ+1-I) = 0 END DO DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPZ02(1,CURSIZ,CU2(1,J),LOC2,UNIT) END DO IC = GRGETC(ICHAN) IF (IC.EQ.-1) THEN IY = MIN(511-CURCEN+1,IY+STEP) ELSE IF (IC.EQ.-2) THEN IY = MAX(CURCEN-1,IY-STEP) ELSE IF (IC.EQ.-3) THEN IX = MIN(511-CURCEN+1,IX+STEP) ELSE IF (IC.EQ.-4) THEN IX = MAX(CURCEN-1,IX-STEP) ELSE IF (IC.EQ.-11) THEN STEP = 1 ELSE IF (IC.EQ.-12) THEN STEP = 4 ELSE IF (IC.EQ.-13) THEN STEP = 16 ELSE IF (IC.EQ.-14) THEN STEP = 64 END IF C --- Erase cursor by restoring former image contents DO J=1,CURSIZ LOC2(1) = IYG-CURCEN+J CALL GRPZ02(1,CURSIZ,CU1(1,J),LOC2,UNIT) END DO IF (IC.LE.0 .OR. IC.GT.255) GOTO 10 IER = SYS$DASSGN(%VAL(ICHAN)) C----------------------------------------------------------------------- END es may be used. The values shoupgplot/drivers/old/ikdriv.f010064400040640000322000000434420563172162100164370ustar00tjpcitmbr00000400000017 SUBROUTINE IKDRIV(IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Ikon devices. C--- C Supported device: Digisolve Ikon Pixel Engine C C Device type code: /IKon. C C Default device name: IKON_DEFAULT (a logical name). C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 1024 by 780 pixels. C C Color capability: Color indices 0-255 are supported. The default C representation is listed in Chapter 5 of the PGPLOT manual. The C representation of all color indices can be changed. C C Input capability: C C File format: It is not possible to send IKON plots to a disk file. C C Obtaining hardcopy: Not possible. C--- C 30-Jan-1988 - [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' C CHARACTER MSG*10 INTEGER GRIK00, SYS$DASSGN, GRGMEM, SYS$QIOW INTEGER I0, J0, ISTAT INTEGER*2 ITMP(9), INIT(51), IOSB(4) INTEGER IREM, ICHAN, MXCNT, ICNT, IBADR, ICOL, NPTS, INEWP SAVE IREM, ICHAN, MXCNT, ICNT, IBADR, ICOL, NPTS, INEWP LOGICAL APPEND SAVE APPEND DATA INIT/82,15,0, 0, 0, 0, 255,255,255, 255, 0, 0, : 0,255, 0, 0, 0,255, 0,255,255, 255, 0,255, : 255,255, 0, 255,127, 0, 127,255, 0, 0,255,127, : 0,127,255, 127, 0,255, 255, 0,127, 85, 85, 85, : 170,170,170/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,170,180,900,200, & 210,900,230) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in IK device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR='IKON' LCHR=LEN(CHR) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=1023 RBUF(3)=0 RBUF(4)=779 RBUF(5)=0 RBUF(6)=255 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=50.0 RBUF(2)=50.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- C I= Interactive device C C= Cursor C N= No hard dash C A= Area fill C N= No hard thick lines 40 CHR='ICNANNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='IKON_DEFAULT' LCHR=LEN(CHR) NBUF=1 RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=1023 RBUF(3)=0 RBUF(4)=779 RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 CALL INIK03(NINT(RBUF(2))) RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 APPEND=RBUF(3).NE.0.0 RBUF(2)=GRIK00(ICHAN,CHR,LCHR) RBUF(1)=ICHAN C--- C- Allocate a buffer. MXCNT=8192 ISTAT=GRGMEM(MXCNT,IBADR) IF(ISTAT.NE.1) THEN CALL GRWARN('Unable to allocate virtual memory.') C- Error return 92 CALL GRGMSG(ISTAT) RBUF(2)=0 CALL SYS$DASSGN(%val(ICHAN)) RETURN END IF C- MXCNT is the number of INTEGER*2 MXCNT=MXCNT/2 ICNT=0 C- Define channel for use by GRIK03. CALL INIK03(ICHAN) C--- C- If device opened remotely, set remote flag. Note, current C- driver does not support remote access. C--- IF(NINT(RBUF(2)).EQ.1) THEN IREM=0 ELSE IF(NINT(RBUF(2)).EQ.3) THEN IREM=1 RBUF(2)=1 ELSE C- Error condition. RETURN END IF C- Set last (x,y) to be invalid CALL INIK01 C--- C- Reset. IF(.NOT.APPEND) THEN C- Reset interface. ISTAT=SYS$QIOW(,%val(ICHAN), : %val(IO$_WRITEVBLK.OR.IO$M_RESET), : ,,,%val(0),%val(0),,,,) C- Wait for status line A to go low (about 2.2 sec) 94 ISTAT=SYS$QIOW(,%VAL(ICHAN), : %val(IO$_WRITEVBLK),IOSB, : ,,%val(0),%val(0),,,,) IF(ISTAT.NE.1) GOTO 92 IF((IOSB(3).AND.'800'x) .NE. 0) THEN CALL LIB$WAIT(0.25) GOTO 94 END IF END IF C- Set 8-bit register $3F (set mode) to 32 (non-buffered mode) ITMP(1)=96*256+63 ITMP(2)=32 CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT) CALL GRIK03(%val(IBADR),ICNT) C- Set 8-bit register $00 (Background color) to 0. ITMP(1)=96*256+0 ITMP(2)=0 CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT) C- Select frame buffer 0 to write ITMP(1)=125*256+0 C- Select frame buffer 0 to read ITMP(2)=124*256+0 C- Load reg. 74=xA4, AUX port setup (0 trans, rel. mouse, 19200 baud). ITMP(3)=96*256+74 ITMP(4)=227 C- Disable clipping (useful if APPENDing to a GKS plot). ITMP(5)=203 CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT) IF(.NOT.APPEND) THEN C- Load default lookup table (if not appending). CALL GRIK02(INIT,51,%val(IBADR),ICNT,MXCNT) END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CALL SYS$DASSGN(%val(ICHAN)) CALL GRFMEM(MXCNT,IBADR) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 IF(.NOT.APPEND) THEN C- Set frame buffer to background color. ITMP(1)=161 CALL GRIK02(ITMP,1,%val(IBADR),ICNT,MXCNT) END IF APPEND=.FALSE. RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 CALL GRIK01(RBUF,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 CALL GRIK05(RBUF,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),255)) RBUF(1)=ICOL ITMP(1)=65*256+ICOL CALL GRIK02(ITMP,1,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 CALL GRIK03(%val(IBADR),ICNT) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- 170 I0=RBUF(1) J0=RBUF(2) CALL GRIK04(ICHAN,I0,J0,CHR,%val(IBADR),ICNT,MXCNT) RBUF(1)=I0 RBUF(2)=J0 NBUF=2 LCHR=1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C- Requires Ikon firmware revision V1.2 (or greater) 200 IF(NPTS.EQ.0) THEN NPTS=RBUF(1) C- Set fill drawing color register (p. 59) ITMP(1)=69*256+ICOL C- Set fill area style to solid (p. 186) ITMP(2)=97*256+52 ITMP(3)=0 CALL GRIK02(ITMP,3,%val(IBADR),ICNT,MXCNT) INEWP=1 ELSE NPTS=NPTS-1 IF(INEWP.NE.0) THEN INEWP=0 C- Draw filled polygon ITMP(1)=188 ITMP(2)=0 ITMP(3)=NPTS ITMP(4)=RBUF(1) ITMP(5)=RBUF(2) CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT) ELSE ITMP(1)=RBUF(1) ITMP(2)=RBUF(2) CALL GRIK02(ITMP,2,%val(IBADR),ICNT,MXCNT) END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- 210 ITMP(1)=81 ITMP(2)=NINT(RBUF(1)) ITMP(3)=IAND(255,INT(RBUF(2)*255.999)) ITMP(4)=IAND(255,INT(RBUF(3)*255.999)) ITMP(5)=IAND(255,INT(RBUF(4)*255.999)) CALL GRIK02(ITMP,5,%val(IBADR),ICNT,MXCNT) RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C- Send CHR array directly to Ikon (user better know what he is doing!) 230 CALL GRIK02(%ref(CHR),LCHR/2,%val(IBADR),ICNT,MXCNT) RETURN C----------------------------------------------------------------------- END INTEGER FUNCTION GRIK00(LUN,CHR,LCHR) C----------------------------------------------------------------------- C Open a channel to the IKON device. C C GRIK00 (returns integer): Opens a channel to the IKON device. C C 9-Dec-1987 - [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER LUN, LCHR CHARACTER CHR*(*) INTEGER IER, ITEMP, ISTAT, LENGTH INTEGER SYS$ASSIGN, SYS$QIOW INTEGER*2 IOSB(4) C--- C- Assign an i/o channel C--- IER = SYS$ASSIGN(CHR(:LCHR), LUN,,) IF(IER.NE.SS$_NORMAL .AND. IER.NE.SS$_REMOTE) GOTO 800 C--- C- Poll the interface waiting for status line A to go low. C--- 100 CALL LIB$WAIT(0.5) ISTAT = SYS$QIOW(,%val(LUN), : %val(IO$_WRITEVBLK),IOSB, : ,,%val(0),%val(0),,,,) IF( (IOSB(3).AND.'800'X) .NE. 0) GOTO 100 C--- IF(IER .EQ. SS$_REMOTE) THEN C--- C Cannot check device characteristics easily if network device being used C so just check whether we opened the device successfully and return C Read back the status from assign to plotting device over network C--- IER=SYS$QIOW(,%VAL(LUN),%VAL(IO$_READVBLK), : IOSB,,,ISTAT,LENGTH,,,,) IF(IOSB(1) .NE. SS$_NORMAL) THEN CALL GRWARN ('Unable to read status from ASSIGN to' // : ' graphics device on remote node') WRITE(6,*) IOSB(2), ' bytes read' ITEMP=IOSB(1) CALL GRGMSG(ITEMP) GRIK00=0 RETURN END IF IF(ISTAT .NE. SS$_NORMAL) THEN IER=ISTAT GOTO 800 ELSE GRIK00=3 RETURN END IF END IF C--- C- Successful completion C--- GRIK00 = 1 RETURN C--- C- Error exit C--- 800 CALL GRWARN('Cannot open graphics device '//CHR(:LCHR)) CALL GRGMSG(IER) GRIK00 = 0 END SUBROUTINE GRIK01(RBUF,IBUF,ICNT,MXCNT) REAL RBUF(4) INTEGER ICNT, MXCNT INTEGER*2 IBUF C----------------------------------------------------------------------- C Part of PGPLOT device driver for IKON C Draw a line segment. C C Arguments: C RBUF(*) (input) Draw line from (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)) C IBUF (input) Address of a buffer area C ICNT (in/out) Number of bytes in use in buffer C MXCNT (input) Maximum size of buffer in bytes C C 30-Jan-1988 - [AFT] C----------------------------------------------------------------------- INTEGER IPTR INTEGER*2 ITMP(4) INTEGER*2 I0, J0, I1, J1 INTEGER*2 LASTI, LASTJ SAVE LASTI, LASTJ C I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) IF(I0.NE.LASTI .OR. J0.NE.LASTJ) THEN ITMP(1)=164 ITMP(2)=I0 ITMP(3)=J0 IPTR=3 ELSE IPTR=0 END IF ITMP(IPTR+1)=178*256 ITMP(IPTR+2)=I1 ITMP(IPTR+3)=J1 IPTR=IPTR+3 LASTI=I1 LASTJ=J1 CALL GRIK02(ITMP,IPTR,IBUF,ICNT,MXCNT) RETURN C ENTRY INIK01 LASTI=-1 LASTJ=-1 RETURN END SUBROUTINE GRIK02(ITMP, N, IBUF, ICNT, MXCNT) C----------------------------------------------------------------------- C GRPCKG (internal routine for IKON driver): Transfer N words to C the output buffer, flushing the buffer as necessary with the C GRIK03 routine. If the N bytes will not fit into the current C buffer, then the buffer is first dumped. This is to to cause C STR to be transferred as a complete unit. C Based on early versions of GRxx02 routines, this version does not C use any common blocks. C ***NOTE*** INIK03 must be called before any calls to GRIK02 to C set the LUN/Channel to which the buffer should be dumped. C C Arguments: C C ITMP(N) I I*2 Data to be written. C N I I The number of words to transfer. C IBUF I/O I*2 The output buffer. C ICNT I/O I Current number of words used in QBUF. C MXCNT I/O I Maximum number of words that can be stored C -in IBUF. C C 9-Dec-1987 - [AFT]. C----------------------------------------------------------------------- INTEGER N, ICNT, MXCNT, I INTEGER*2 ITMP(N), IBUF(MXCNT) C--- IF(ICNT+N.GE.MXCNT) CALL GRIK03(IBUF,ICNT) DO I=1,N IF(ICNT.GE.MXCNT) CALL GRIK03(IBUF,ICNT) ICNT=ICNT+1 IBUF(ICNT)=ITMP(I) END DO RETURN END SUBROUTINE GRIK03(IBUF,ICNT) INTEGER ICNT INTEGER*2 IBUF(*) C----------------------------------------------------------------------- C GRPCKG(internal routine, IKON): C set the channal to which the buffer should be dumped. C This subroutine contains the entry point INIK03 that defines C the variables ICHAN. C C Arguments: C C IBUF I/O I*2 The output buffer. C ICNT I/O I Current number of words used in QBUF. C C 9-Dec-1987 - [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' INTEGER SYS$QIOW INTEGER ISTAT INTEGER*2 IOSB(4) INTEGER INCHAN INTEGER ICHAN SAVE ICHAN C IF(ICNT.GT.0) THEN ISTAT = sys$qiow(,%val(ICHAN), : %val(IO$_WRITEVBLK.OR.IO$M_SETFNCT.OR.IO$M_TIMED), : IOSB,,,IBUF,%val(2*ICNT),%val(15),%val(0),,) END IF ICNT=0 RETURN C--- ENTRY INIK03(INCHAN) C- Save info needed to dump buffer. ICHAN=INCHAN RETURN END SUBROUTINE GRIK04(ICHAN,IX,IY,CHR,IBUF,ICNT,MXCNT) C INTEGER ICHAN, IX, IY, IBUF, ICNT, MXCNT CHARACTER CHR C C Arguments C ICHAN (input) QIO channel assigned to Args C IX,IY (in/out) The cursor position C CHR (output) The keyboard character pressed C IBUF (input) Address of a buffer area C ICNT (in/out) Number of bytes in use in buffer C MXCNT (input) Maximum size of buffer in bytes C--- C Read the cursor position on the Ikon. The cursor can be moved C by either rolling the tracker ball. C The cursor can also be moved by using the cursor keys on the C terminal associated with SYS$COMMAND in which case the cursor C "speed" (step size) is controlled by the PF1 (smallest step) to C PF4 (largest step) keys. The numeric keys on the keypad can be C used in place of the arrow keys, with the addition of diagonal C motion: C UP C 7 8 9 C LEFT 4 6 RIGHT C 1 2 3 C DOWN C--- C- 21-Jan-1988 - Based on ARDRIVER [AFT]. C--- INCLUDE '($IODEF)' C- INTEGER SYS$QIOW INTEGER SMG$CREATE_VIRTUAL_KEYBOARD, SMG$READ_KEYSTROKE INTEGER ISTAT, IDSMG INTEGER ISTEP, IXWAS, IYWAS, IVAL INTEGER*2 ITMP(9), IOSB(4), ICURS(9) LOGICAL QKEY C--- ISTAT=SMG$CREATE_VIRTUAL_KEYBOARD(IDSMG,'SYS$COMMAND') IF(ISTAT.NE.1) THEN CALL GRGMSG(ISTAT) CALL GRQUIT('Fatal error.') END IF C--- C- Load 32-bit reg. 26=x1A GID max position ITMP(1)=99*256+26 ITMP(2)= 779 ITMP(3)=1023 C- Load 32-bit reg. 28=x1C GID size. ITMP(4)=99*256+28 ITMP(5)= 779 ITMP(6)=1023 CALL GRIK02(ITMP,6,IBUF,ICNT,MXCNT) C- Load reg. 74=xA4, AUX port setup (0 trans, rel. mouse, 19200 baud). ITMP(1)=96*256+74 ITMP(2)=227 C- Set up zone to constrain cursor ITMP(3)=99*256+44 ITMP(4)= 779 ITMP(5)=1023 CALL GRIK02(ITMP,5,IBUF,ICNT,MXCNT) C--- C- Cursor on. ITMP(1)=193 C- Load 8-bit reg. 24=x18 with Enable GID ITMP(2)=96*256+24 ITMP(3)=128 CALL GRIK02(ITMP,3,IBUF,ICNT,MXCNT) C- Defaults. ISTEP=2 QKEY=.FALSE. C--- C- Position cursor. 200 ITMP(1)=164 ITMP(2)=IX ITMP(3)=IY C- Anchor GID to current position (i.e., keep cursor on screen). ITMP(4)=86 CALL GRIK02(ITMP,4,IBUF,ICNT,MXCNT) CALL GRIK03(IBUF,ICNT) IXWAS=IX IYWAS=IY C- See if user has typed something at keyboard. ISTAT=SMG$READ_KEYSTROKE(IDSMG,IVAL,,0) IF(ISTAT.NE.1) IVAL=0 IF(IVAL.EQ.259) THEN C- PF4=large step ISTEP=64 ELSE IF(IVAL.EQ.258) THEN ISTEP=8 ELSE IF(IVAL.EQ.257) THEN ISTEP=4 ELSE IF(IVAL.EQ.256) THEN C- PF1=small step ISTEP=1 ELSE IF(IVAL.EQ.49 .OR. IVAL.EQ.261) THEN C- key 1 or KP1 IX=IX-ISTEP IY=IY-ISTEP ELSE IF(IVAL.EQ.50 .OR. IVAL.EQ.262 .OR. IVAL.EQ.275) THEN C- key 2, KP2 or DOWN IY=IY-ISTEP ELSE IF(IVAL.EQ.51 .OR. IVAL.EQ.263) THEN C- key 3 or KP3 IX=IX+ISTEP IY=IY-ISTEP ELSE IF(IVAL.EQ.52 .OR. IVAL.EQ.264 .OR. IVAL.EQ.276) THEN C- key 4, KP4 or LEFT IX=IX-ISTEP ELSE IF(IVAL.EQ.54 .OR. IVAL.EQ.266 .OR. IVAL.EQ.277) THEN C- key 6, KP6 or RIGHT IX=IX+ISTEP ELSE IF(IVAL.EQ.55 .OR. IVAL.EQ.267) THEN C- key 7 or KP7 IX=IX-ISTEP IY=IY+ISTEP ELSE IF(IVAL.EQ.56 .OR. IVAL.EQ.268 .OR. IVAL.EQ.274) THEN C- key 8, KP8 or UP IY=IY+ISTEP ELSE IF(IVAL.EQ.57 .OR. IVAL.EQ.269) THEN C- key 9 or KP9 IX=IX+ISTEP IY=IY+ISTEP ELSE IF((IVAL.GT.0 .AND. IVAL.LT.48) .OR. & (IVAL.GT.57 .AND. IVAL.LT.255)) THEN QKEY=.TRUE. END IF C--- C- Read current cursor position C**** Due to possible hardware fault the following code will C**** sometimes reset the IKON. ITMP(1)=165 CALL GRIK02(ITMP,1,IBUF,ICNT,MXCNT) CALL GRIK03(IBUF,ICNT) C- Read 4 bytes, timing out in 2 sec. ISTAT = sys$qiow(,%val(ICHAN), : %val(IO$_READVBLK.OR.IO$M_SETFNCT.OR.IO$M_TIMED), : IOSB,,,ICURS,%val(4),%val(2),%val(1),,) IF(ISTAT.EQ.1 .AND. IOSB(1).EQ.1) THEN IX=IX+ICURS(1)-IXWAS IY=IY+ICURS(2)-IYWAS END IF IX=MAX(IX, 0) IX=MIN(IX,1023) IY=MAX(IY, 0) IY=MIN(IY, 779) IF(IX.EQ.IXWAS .AND. IY.EQ.IYWAS) THEN CALL LIB$WAIT(0.05) END IF IF(.NOT.QKEY) GOTO 200 CHR=CHAR(IVAL) C--- C- Turn cursor off ITMP(1)=192 CALL GRIK02(ITMP,1,IBUF,ICNT,MXCNT) CALL GRIK03(IBUF,ICNT) C--- C- Free resources. CALL SMG$DELETE_VIRTUAL_KEYBOARD(IDSMG) RETURN END SUBROUTINE GRIK05(RBUF,IBUF,ICNT,MXCNT) REAL RBUF(2) INTEGER ICNT, MXCNT INTEGER*2 IBUF C----------------------------------------------------------------------- C Part of PGPLOT device driver for IKON C Draw a dot. C C Arguments: C RBUF(*) (input) (RBUF(1),RBUF(2)) is the (x,y) position of the dot. C IBUF (input) Address of a buffer area C ICNT (in/out) Number of bytes in use in buffer C MXCNT (input) Maximum size of buffer in bytes C C 30-Jan-1988 - [AFT] C----------------------------------------------------------------------- INTEGER*2 ITMP(3) C C- Move and draw pixel. ITMP(1)=166 ITMP(2)=RBUF(1) ITMP(3)=RBUF(2) CALL GRIK02(ITMP,3,IBUF,ICNT,MXCNT) CALL INIK01 RETURN END an i/o channel C--- IER = SYS$ASSIGN(CHR(:LCHR), LUN,,) IF(IER.NE.SS$_NORMAL .AND. IER.NE.SS$_REMOTE) GOTO 800 C--- C- Poll the interface waiting for status line A to go low. C--- 100 CALL LIB$WAIT(0.5) ISTAT = SYS$QIOWpgplot/drivers/old/svblock.c010064400040640000322000000015510500761200100165660ustar00tjpcitmbr00000400000017/* This file contains the initialized global variables for the sv driver */ /* Created: 30-Apr-1991 */ /* Sam Southard, Jr. */ char sv_dev_name[] = "SUN" ; int sv_COLOR = 1 ; /* current pen color */ int sv_APPEND = 0 ; /* to erase or not */ #define NCOLOR 32 /* The pre-defined dark grey color is too dark */ unsigned char sv_R_table[NCOLOR] = { 1,255,255, 0, 0, 0,255,255, 255,127, 0, 0,127,255, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; unsigned char sv_G_table[NCOLOR] = { 1,255, 0,255, 0,255, 0,255, 127,255,255,127, 0, 0, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; unsigned char sv_B_table[NCOLOR] = { 1,255, 0, 0,255,255,255, 0, 0, 0,127,255,255,127, 85,170, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255 } ; int sv_NPOLY = 0, sv_POLY = 0 ; pgplot/drivers/old/vedriv.f010064400040640000322000000262350571651546500164620ustar00tjpcitmbr00000400000017C*VEDRIV -- PGPLOT Versatec driver C+ SUBROUTINE VEDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Versatec device. C----------------------------------------------------------------------- C Version 1.0 - 1987 Jun 11 - T. J. Pearson. C Version 1.1 - 1987 Jul 6 - minor changes (TJP). C Version 1.2 - 1987 Aug 19 - add RECL= (TJP). C Version 1.3 - 1987 Sep 1 - correct 'misc defaults' (TJP). C Version 2.0 - 1995 Feb 9 - merge landscape and portrait modes (TJP). C----------------------------------------------------------------------- C C Supported device: Versatec V80 dot-matrix printer. C C Device type code: /VERSATEC (landscape orientation) C /VVERSATEC (portrait orientation) C C Default device name: pgplot.veplot C C Default view surface dimensions: 10.5in (horizontal) by 8.0in C (vertical) in landscape mode, 8.0 by 10.5 in portrait mode. C C Resolution: 200 (x) x 200 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 264 bytes, with C embedded carriage-control characters. A full-page plot occupies C 832 512-byte blocks. C C Obtaining hardcopy: Use the command VMS PRINT/PASSALL. C----------------------------------------------------------------------- CHARACTER*(*) TYPEL, TYPEP, DEFNAM PARAMETER (TYPEL='VERSATEC') PARAMETER (TYPEP='VVERSATEC') PARAMETER (DEFNAM='pgplot.veplot') CHARACTER FF PARAMETER (FF=CHAR(12)) C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER BITMAP REAL XBUF(4) C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in Versatec device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF (MODE.EQ.1) THEN CHR = TYPEL LCHR = LEN(TYPEL) ELSE IF (MODE.EQ.2) THEN CHR = TYPEP LCHR = LEN(TYPEP) ELSE CHR = 'Unknown' LCHR = 7 END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(3) = 0 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 IF (MODE.EQ.1) THEN RBUF(2) = 2099 RBUF(4) = -1 ELSE RBUF(2) = -1 RBUF(4) = 2099 END IF RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 200.0 RBUF(2) = 200.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 2099 RBUF(3) = 0 RBUF(4) = 1599 IF (MODE.EQ.1) THEN RBUF(2) = 2099 RBUF(4) = 1599 ELSE RBUF(2) = 1599 RBUF(4) = 2099 END IF NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 3 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- dimensions of plot buffer (263=2100/8) BX = 263 BY = 1600 CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', : DEFAULTFILE=DEFNAM, STATUS='NEW', RECL=128, : FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for Versatec plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER CLOSE (UNIT=UNIT, STATUS='DELETE') CALL GRFLUN(UNIT) END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, STATUS='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE NPICT = NPICT+1 C% type *,'Begin picture',NPICT IF (NPICT.GT.1) WRITE (UNIT=UNIT) FF CALL GRVE03(BX*BY, %VAL(BITMAP)) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IF (MODE.EQ.1) THEN CALL GRVE01(1, RBUF, IC, BX, BY, %VAL(BITMAP)) ELSE XBUF(1) = RBUF(2) XBUF(2) = 1599 - RBUF(1) XBUF(3) = RBUF(4) XBUF(4) = 1599 - RBUF(3) CALL GRVE01(1, XBUF, IC, BX, BY, %VAL(BITMAP)) END IF RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IF (MODE.EQ.1) THEN CALL GRVE01(0, RBUF, IC, BX, BY, %VAL(BITMAP)) ELSE XBUF(1) = RBUF(2) XBUF(2) = 1599 - RBUF(1) CALL GRVE01(0, XBUF, IC, BX, BY, %VAL(BITMAP)) END IF RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT CALL GRVE02(UNIT, BX, BY, %VAL(BITMAP)) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRVE01 -- PGPLOT Versatec driver, draw line C+ SUBROUTINE GRVE01 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BX,BY) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:7) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /128, 64, 32, 16, 8, 4, 2, 1/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = D IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO 10 K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/8+1,KY+1) = BITMAP(KX/8+1,KY+1) .OR. 1 QMASK(MOD(KX,8)) XP = XP + XINC YP = YP + YINC 10 CONTINUE ELSE DO 20 K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/8+1,KY+1) = BITMAP(KX/8+1,KY+1) .AND. 1 (.NOT.QMASK(MOD(KX,8))) XP = XP + XINC YP = YP + YINC 20 CONTINUE END IF END C*GRVE02 -- PGPLOT Versatec driver, copy bitmap to output file C+ SUBROUTINE GRVE02 (UNIT, BX, BY, BITMAP) INTEGER UNIT, BX, BY BYTE BITMAP(BX,BY) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE PREFIX DATA PREFIX/ 4/ INTEGER I, J, K C C Write bitmap. C DO 15 J=1,BY DO 5 K=BX,2,-1 IF (BITMAP(K,J).NE.0) GOTO 10 5 CONTINUE 10 WRITE (UNIT=UNIT) PREFIX,(BITMAP(I,J),I=1,K) 15 CONTINUE C END C*GRVE03 -- PGPLOT Versatec driver, zero bitmap C+ SUBROUTINE GRVE03(BUFSIZ, BUFFER) C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL/0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END pgplot/drivers/old/ardriv.html010064400040640000322000000016220613473755200171600ustar00tjpcitmbr00000400000017 ARDRIV

Args Image Device

Supported device
Sigma Args, 7000 series.
Device type code
/ARgs.
Default device name
ARGS_DEVICE (a logical name).
Resolution
The full view surface is 512 by 512 pixels.
Color capability
Color indices 0--255 are supported. The representation of all color indices can be changed.
Input capability
A cursor routine is provided that works on Starlink Args devices. It is possible to move the cursor with either the tracker ball or by using the arrow keys on the terminal (SYS$COMMAND); the PF1 to PF4 keys can be used to control the rate at which the arrow keys move the cursor. Terminate the cursor (in all cases) by typing any printable character on the keyboard.
Author
Allyn F. Tennant, 1988.
pgplot/drivers/old/grdriv.html010064400040640000322000000025730613473754400171750ustar00tjpcitmbr00000400000017 GRDRIV

Grinnell Image Display (obsolete)

Supported device
Grinnell GMR-270 Image Display System.
Device type code
/GRINNELL.
Default device name
TV_DEVICE (a logical name, usually defined by the system manager).
Default view surface dimensions
Depends on monitor.
Resolution
The full view surface is 512 x 512 pixels.
Color capability
Color indices 0--255 are supported. The representation of all color indices can be changed.
Input capability
The graphics cursor is a white cross-hair. The user positions the cursor using the arrow keys and PF1--PF4 keys on his terminal keyboard (SYS$COMMAND). The arrow keys move the cursor in the appropriate direction; the size of the step for each keystroke is controlled by the PF1--PF4 keys: PF1 = 1 pixel, PF2 = 4 pixels, PF3 = 16 pixels, PF4 = 64 pixels. The user indicates that the cursor has been positioned by typing any character other than an arrow or PF1--PF4 key [control characters, e.g., ctrl-C, and other special characters should be avoided, as they may be intercepted by the operating system].
File format
It is not possible to send Grinnell plots to a disk file.
Obtaining hardcopy
Not possible.
Author
T. J. Pearson, 1989.
pgplot/drivers/old/ikdriv.html010064400040640000322000000011600613473753400171560ustar00tjpcitmbr00000400000017 IKDRIV

Digisolve Ikon Pixel Engine (IKDRIV)

Supported device
Digisolve Ikon Pixel Engine.
Device type code
/IKon.
Default device name
IKON_DEFAULT (a logical name).
Default view surface dimensions
Depends on monitor.
Resolution
The full view surface is 1024 by 780 pixels.
Color capability
Color indices 0--255 are supported. The representation of all color indices can be changed.
Input capability
?
Author
A. F. Tennant, 1988.
pgplot/drivers/old/pkdriv.html010064400040640000322000000027160613473750500171730ustar00tjpcitmbr00000400000017 PKDRIV

Peritek VCH-Q Display, 1024-pixel

Supported device
Peritek Corp. VCK-Q frame-buffer video interface with HD63484 ACRTC, using a custom VMS device driver. (Peritek Corp., 5550 Redwood Rd., Oakland, CA 94619, 415-531-6500)
Device type code
/PK.
Default device name
PKA0:
Default view surface dimensions
Depends on monitor.
Resolution
The full view surface is 1024 x 1024 pixels.
Color capability
Color indices 0--255 are supported. The representation of all color indices can be changed. Define logical name PGPLOT_MONITOR = MONOCHROME to use a monochrome monitor: colors are then converted to shades of gray.
Input capability
The graphics cursor is a white cross-hair. The user positions the cursor using the arrow keys and PF1--PF4 keys on his terminal keyboard (SYS$COMMAND). The arrow keys move the cursor in the appropriate direction; the size of the step for each keystroke is controlled by the PF1--PF4 keys: PF1 = 1 pixel, PF2 = 4 pixels, PF3 = 16 pixels, PF4 = 64 pixels. The user indicates that the cursor has been positioned by typing any character other than an arrow or PF1--PF4 key [control characters, eg, ctrl-C, and other special characters should be avoided, as they may be intercepted by the operating system].
Author
C. K. Lee, 1989.
pgplot/drivers/old/pzdriv.html010064400040640000322000000016660613473744100172140ustar00tjpcitmbr00000400000017 PZDRIV

Peritek VCH-Q Display, 512-pixel (PZDRIV)

Supported device
Peritek Corp. VCH-Q frame-buffer video interface with HD6845 CRTC, using a custom VMS device driver. (Peritek Corp., 5550 Redwood Rd., Oakland, CA 94619, 415-531-6500)
Device type code
/PERITEK.
Default device name
TV_DEVICE (a logical name, usually defined by the system manager).
Default view surface dimensions
Depends on monitor.
Resolution
The full view surface is 512 x 512 pixels.
Color capability
Color indices 0--255 are supported. The representation of all color indices can be changed. As the device is normally connected to a monochrome monitor, all colors are converted to grayscale by averaging the R, G, B components.
Input capability
Not implemented.
Author
T. J. Pearson, 1987.
pgplot/drivers/old/vedriv.html010064400040640000322000000017240571652177200171730ustar00tjpcitmbr00000400000017 VEDRIV

Versatec Printers

Supported device
Versatec V80 dot-matrix printer.
Device type code
/VERSATEC (landscape orientation), /VVERSATEC (portrait orientation).
Default device name
PGPLOT.VEPLOT, PGPLOT.VVPLOT.
Default view surface dimensions
10.5 in (horizontal) by 8.0 in (vertical) for landscape, 8.0 in by 10.5 in for portrait.
Resolution
200 pixels/inch.
Color capability
Color indices 0 (erase, white) and 1 (black) are supported. It is not possible to change color representation.
Input capability
None.
File format
Variable-length records, maximum 264 bytes, with embedded carriage-control characters. A full-page plot occupies 832 512-byte blocks.
Obtaining hardcopy
(VMS) Use the command PRINT/PASSALL.
Author
T. J. Pearson, 1987.
pgplot/drivers/old/lidriv.f010064400040640000322000000312750566772507000164540ustar00tjpcitmbr00000400000017C Date: 3-FEB-1988 15:08:32 GMT C From: AFT@AST-STAR.CAM.AC.UK C To: TJP@CITPHOBO C Subject: LIDRIVER.FOR C*LIDRIV -- PGPLOT driver form Liacom device SUBROUTINE LIDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) C- GRPCKG driver for Liacom image device. C--- C Supported device: Liacom Graphic Video Display (GVD-02). C C Device type code: /LIacom C C Default device name: LIACOM_DEVICE (a logical name). C C Default view surface dimensions: Depends on monitor. C C Resolution: The full view surface is 512 by 512 pixels. C C Color capability: Color indices 0-15 are supported. The default C color representation is as listed in Chapter 5 of the PGPLOT C Manual. The representation of all color indices can be changed. C Color indices 128-255 map into the second row of bit planes and C support 15 levels of grey scale. C C Input capability: Cursor is a fat white cross. C C File format: It is not possible to send Liacom plots to a disk file. C C Obtaining hardcopy: Not possible. C C 5-Aug-1986 - [AFT]. C 16-Jan-1988 - Track PGPLOT [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER IFUNC,NBUF,LCHR,I0,J0,I1,J1 REAL RBUF(6) CHARACTER CHR*(*) C INTEGER GRGE00, SYS$DASSGN, GRGMEM, IER INTEGER*2 ITMP(10), ICHAN INTEGER IREM, IWRT, IRD, LUN, MXCNT, ICNT, IBADR, ICOL SAVE IREM, IWRT, IRD, LUN, MXCNT, ICNT, IBADR, ICOL LOGICAL APPEND SAVE APPEND C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,170,999,999,999, & 210,999,230) IFUNC GOTO 999 C--- C- IFUNC= 1, Return device name. 10 CHR='LIACOM' LCHR=LEN(CHR) RETURN C--- C- IFUNC= 2, Return Physical min and max for plot device. 20 RBUF(1)=0 RBUF(2)=511 RBUF(3)=0 RBUF(4)=511 RBUF(5)=0 RBUF(6)=255 NBUF=6 RETURN C--- C- IFUNC= 3, Return device (X and Y) resolution in pixels per inch as C- formatted numbers in CHR. 30 RBUF(1)=50.0 RBUF(2)=50.0 RBUF(3)=1 NBUF=3 RETURN C--- C- IFUNC= 4, Return misc device info. 40 CHR='ICNNNNNNNN' LCHR=10 RETURN C--- C- IFUNC= 5, Return default file name. 50 CHR='LIACOM_DEVICE' LCHR=LEN(CHR) NBUF=1 RETURN C--- C- IFUNC= 6, Return default physical size of plot. 60 RBUF(1)=0 RBUF(2)=511 RBUF(3)=0 RBUF(4)=511 RETURN C--- C- IFUNC= 7, Return misc defaults. 70 RBUF(1)=1 NBUF=1 RETURN C--- C- IFUNC= 8, Set active plot. 80 CALL INIT03(1,LUN,IWRT) RETURN C--- C- IFUNC= 9, Open workstation. 90 APPEND = RBUF(3).NE.0.0 RBUF(2)=GRGE00('Q2 ',LUN,CHR,LCHR) IF(RBUF(2).EQ.1) THEN IREM=0 IWRT='000010A0'X IRD ='000010A0'X ELSE IF(RBUF(2).EQ.3) THEN IREM=1 IWRT=IO$_WRITEVBLK IRD =IO$_READVBLK RBUF(2)=1 ELSE IWRT=0 END IF RBUF(1)=LUN IF(NINT(RBUF(2)).EQ.1) THEN MXCNT=8192 IER=GRGMEM(MXCNT,IBADR) IF(IER .NE. SS$_NORMAL) THEN CALL GRGMSG(IER) CALL GRWARN('Unable to allocate virtual memory.') RBUF(2)=0 CALL SYS$DASSGN(%val(LUN)) RETURN END IF CALL INIT03(1,LUN,IWRT) IF(RBUF(3).EQ.0) CALL GRLI10(%val(IBADR),ICNT,MXCNT) END IF RETURN C--- C- IFUNC=10, Close workstation. 100 IF(IREM.NE.0) CALL GRLI12(LUN) CALL SYS$DASSGN(%val(LUN)) CALL GRFMEM(MXCNT,IBADR) RETURN C--- C- IFUNC=11, Begin Picture. 110 ITMP(1)='1088'x ! Select cursor ITMP(2)='7000'x ! Cursor off ITMP(3)='103F'x ! Select all bit planes ITMP(4)='700F'x ! Set video blank to open (display on) ITMP(5)='1010'x+ICOL ! Select planes corresponding to color CALL GRGE02(ITMP,10,%val(IBADR),ICNT,MXCNT) CALL GRGE03(%val(IBADR),ICNT) IF(.NOT.APPEND) THEN ITMP(1)='103F'x ! Select all bit planes ITMP(2)='3000'x ! Erase CALL GRGE02(ITMP, 4,%val(IBADR),ICNT,MXCNT) END IF APPEND=.FALSE. RETURN C--- C- IFUNC=12, Draw line. 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRLI01(I0,J0,I1,J1,%val(IBADR),ICNT,MXCNT,ICOL) RETURN C--- C- IFUNC=13, Draw dot. 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRLI01(I0,J0,I0,J0,%val(IBADR),ICNT,MXCNT,ICOL) RETURN C--- C- IFUNC=14, End Picture. 140 RETURN C--- C- IFUNC=15, Select color index. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),255)) RBUF(1)=ICOL 155 IF(ICOL.GT.0) THEN IF(ICOL.LT.128) THEN C- Select bit planes in row 1. ITMP(1)='1010'x+IAND(ICOL,15) ELSE C- Select bit planes in row 2 (must be in range 1-15). ITMP(1)='1020'x+1+INT(15.*IAND((ICOL-128),127)/128.) END IF ELSE C- Select all planes in both rows. ITMP(1)='103F'x END IF CALL GRGE02(ITMP,2,%val(IBADR),ICNT,MXCNT) RETURN C--- C- IFUNC=16, Flush buffer. 160 CALL GRGE03(%val(IBADR),ICNT) RETURN C--- C- IFUNC=17, Make cursor visible and read position. 170 I0=RBUF(1) J0=RBUF(2) CALL GRLI11(I0,J0,CHR,LUN,%val(IBADR),ICNT,MXCNT,ICOL,IRD) RBUF(1)=I0 RBUF(2)=J0 NBUF=2 LCHR=1 RETURN C--- C- IFUNC=21, Set color representation. 210 ITMP( 1)='1084'x ! Select LUT. ICHAN=NINT(RBUF(1)) IF(ICHAN.LT.128) THEN C- Select bit planes in row 1. ICHAN=IAND(ICHAN,15) ELSE C- Select bit planes in row 2. ICHAN=1+INT(15.*IAND((ICHAN-128),127)/128.) ICHAN=16*ICHAN END IF C ITMP( 2)='4300'x+ICHAN ! Load address ITMP( 3)='7001'x ! Enable channel 1 (red). I0=IAND(255,INT(RBUF(2)*255.999)) ITMP( 4)='5000'x+I0 ! Load data (color level). C ITMP( 5)='4300'x+ICHAN ! Load address ITMP( 6)='7002'x ! Enable channel 2 (green). I0=IAND(255,INT(RBUF(3)*255.999)) ITMP( 7)='5000'x+I0 ! Load data (color level). C ITMP( 8)='4300'x+ICHAN ! Load address ITMP( 9)='7004'x ! Enable channel 4 (blue). I0=IAND(255,INT(RBUF(4)*255.999)) ITMP(10)='5000'x+I0 ! Load data (color level). C CALL GRGE02(ITMP,20,%val(IBADR),ICNT,MXCNT) GOTO 155 C--- C- IFUNC=23, Escape. 230 CALL GRGE02(%ref(CHR),LCHR,%val(IBADR),ICNT,MXCNT) RETURN C--- C- Flag function not implemented. 999 NBUF=-1 RETURN END SUBROUTINE GRLI01 (I0,J0,I1,J1,IBUF,ICNT,MXCNT,ICOL) C----------------------------------------------------------------------- C GRPCKG (internal routine, Liacom): draw a line segment. The VAX can C send data to the Liacom faster than the Liacom can plot it, if lines C are more than 255 pixels in length. To avoid this problem, long C lines must be broken into shorter segments. C C Arguments: C C I0,J0 (integer, input): the column and row numbers of the starting C point. C I1,J1 (integer, input): the column and row numbers of the end point. C C 11-Apr-1983 - Original. C 18-Jan-1988 - Break long lines into segments [AFT]. C----------------------------------------------------------------------- INTEGER I0,J0,I1,J1,IBUF,ICNT,MXCNT,ICOL C INTEGER CLIP511,X INTEGER IC0, JC0, IC1, JC1, IDXA, IDYA INTEGER IDX, IDY, IDIST, ISX, ISY INTEGER*2 ITMP(11) C--- CLIP511(X) = X .AND. '1FF'X C IC0 = CLIP511(I0) JC0 = CLIP511(J0) IC1 = CLIP511(I1) JC1 = CLIP511(J1) IDX= IC1-IC0 IDY= JC1-JC0 JC0= 511-JC0 IDXA= ABS(IDX) IDYA= ABS(IDY) IF(IDX.LT.0) THEN ISX='0200'x ELSE ISX=0 END IF IF(IDY.LT.0) THEN ISY='0200'x ELSE ISY=0 END IF IDIST=IDXA*IDXA+IDYA*IDYA C--- ITMP(1) = '4000'x .OR. IC0 ! LXA ITMP(2) = '5000'x .OR. JC0 ! LYA IF(IDIST.EQ.0) THEN IF(ICOL.GT.0) THEN ITMP(3)='8010'x ELSE ITMP(3)='8000'x END IF CALL GRGE02(ITMP, 6,IBUF,ICNT,MXCNT) ELSE IF(IDIST.LE.255*255) THEN C--- C- Short lines can be dones as a single vector. C IF(ICOL .GT. 0) THEN C- FSV-positive. ITMP(3) = '2001'x ELSE C- FSV-negative ITMP(3) = '2000'x ENDIF C- Note reverse order. ITMP(4) = IDYA .OR. ISY ITMP(5) = IDXA .OR. ISX CALL GRGE02(ITMP,10,IBUF,ICNT,MXCNT) ELSE IF(IDIST.LE.2*255*255) THEN C--- C- Break vector into two segments. IF(ICOL .GT. 0) THEN C- FSV-positive. ITMP(3) = '2001'x ITMP(6) = '2001'x ELSE C- FSV-negative ITMP(3) = '2000'x ITMP(6) = '2000'x ENDIF C- Note reverse order. IDY=IDYA/2 ITMP(4)=IDY .OR. ISY IDX=IDXA/2 ITMP(5)=IDX .OR. ISX ITMP(7)=(IDYA-IDY) .OR. ISY ITMP(8)=(IDXA-IDX) .OR. ISX CALL GRGE02(ITMP,16,IBUF,ICNT,MXCNT) ELSE C--- C- Break vector into three segments. (The line must be diagonal.) IF(ICOL .GT. 0) THEN C- FSV-positive. ITMP(3) = '2001'x ITMP(6) = '2001'x ITMP(9) = '2001'x ELSE C- FSV-negative ITMP(3) = '2000'x ITMP(6) = '2000'x ITMP(9) = '2000'x ENDIF C- Note reverse order. IDY=IDYA/3 ITMP(4)=IDY .OR. ISY ITMP(7)=ITMP(4) IDX=IDXA/3 ITMP(5)=IDX .OR. ISX ITMP(8)=ITMP(5) ITMP(10)=(IDYA-2*IDY) .OR. ISY ITMP(11)=(IDXA-2*IDX) .OR. ISX CALL GRGE02(ITMP,22,IBUF,ICNT,MXCNT) END IF C RETURN END SUBROUTINE GRLI10(IBUF,ICNT,MXCNT) C-------------------------------------------------------------------- C GRPCKG (Internal routine, Liacom) C Loads standard PGPLOT look-up table. C-------------------------------------------------------------------- INTEGER IBUF(1),ICNT,MXCNT INTEGER*2 LIABUF(58)/'1084'X, 'C001'X, '0000'X, & '7001'x, '4300'x, '5000'x, '50FF'x, '50FF'x, '5000'x, & '5000'x, '5000'x, '50FF'x, '50FF'x, & '50FF'x, '508F'x, '5000'x, '5000'x, & '508F'x, '50FF'x, '5055'x, '50AA'x, & '7002'x, '4300'x, '5000'x, '50FF'x, '5000'x, '50FF'x, & '5000'x, '50FF'x, '5000'x, '50FF'x, & '508F'x, '50FF'x, '50FF'x, '508F'x, & '5000'x, '5000'x, '5055'x, '50AA'x, & '7004'x, '4300'x, '5000'x, '50FF'x, '5000'x, '5000'x, & '50FF'x, '50FF'x, '50FF'x, '5000'x, & '5000'x, '5000'x, '508F'x, '50FF'x, & '50FF'x, '508F'x, '5055'x, '50AA'x, & '1010'x/ C--- C- Actions taken by LIABUF are: C- Select lookup table, send block of zeros, C- for each channel define bottom 8 colors, C- Select bottom plane only (color 1). C--- CALL GRGE02(LIABUF,116, IBUF,ICNT,MXCNT) CALL GRGE03(IBUF,ICNT) RETURN END SUBROUTINE GRLI11(IX,IY,LETTER,LUN,IBUF,ICNT,MXCNT,ICOL,IRD) C------------------------------------------------------------ C GRLI11: (Grpckg internal routine, Liacom) C Make cursor visible, then after reading a character C from the terminal, read the cursor position. C C Arguments: C C IX,IY (integer, input/output): position of cursor. C LETTER (character, output): character typed by user. C C 19-OCT-1983 C------------------------------------------------------------ INCLUDE '($SSDEF)' INTEGER IX, IY, LUN, IBUF(1), ICNT, MXCNT, ICOL, IRD CHARACTER LETTER INTEGER*2 X, Y, LIABUF(4), IOSB(5) INTEGER SYS$QIOW, SYS$ASSIGN, SYS$DASSGN, GRGETC INTEGER I INTEGER ICHAN, IER C--- IF(IX .LT. 0) THEN X= 0 ELSE IF(IX .GT. 511) THEN X= 511 ELSE X= IX END IF C IF(IY .LT. 0) THEN Y= 0 ELSE IF(IY .GT. 511) THEN Y= 511 ELSE Y= IY END IF C IER = SYS$ASSIGN('TT', ICHAN, ,) IF(IER .NE. 1) THEN CALL GRGMSG(IER) CALL GRQUIT('Fatal error.') END IF C LIABUF(1)= '1088'X ! Select cursor. LIABUF(2)= '7003'X ! Make visible, non-blinking. LIABUF(3)= '4000'X .OR. X ! Load X address. LIABUF(4)= '5000'X .OR. (511-Y) ! Load Y address. CALL GRGE02(LIABUF, 8, IBUF,ICNT,MXCNT) CALL GRGE03(IBUF,ICNT) C LETTER= CHAR(GRGETC(ICHAN)) C LIABUF(1)= 'F002'X ! Initiate readback. CALL GRGE02(LIABUF, 2, IBUF,ICNT,MXCNT) CALL GRGE03(IBUF,ICNT) C IER= SYS$QIOW(,%val(LUN), %val(IRD),IOSB,,, & LIABUF, %val(6), %val(5),,,) IF(IER .NE. SS$_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Error reading from Liacom.') END IF C DO I=1, 3 END DO C IX= LIABUF(2) .AND. '01FF'X IY= LIABUF(3) .AND. '01FF'X IY= 511-IY C IER= SYS$DASSGN(%val(ICHAN)) C LIABUF(1)= '7000'X ! Make cursor invisible. LIABUF(2)= '1010'X + ICOL ! Back to vector graphics. CALL GRGE02(LIABUF, 4, IBUF,ICNT,MXCNT) CALL GRGE03(IBUF,ICNT) C RETURN END SUBROUTINE GRLI12(LUN) C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER SYS$QIOW INTEGER LUN INTEGER IER, LENGTH, ITEMP INTEGER*2 LIABUF, IREC, IOSB(4) C--- IREC='FFFF'X C C For the Liacom across the network send an END request and wait to be told C that the Liacom has been deassigned - this avoids problems of trying C to reallocate it before it has been deassigned C LIABUF='2002'X LENGTH=2 IER=SYS$QIOW(,%val(LUN),%val(IO$_WRITEVBLK),IOSB,,, : LIABUF,%val(LENGTH),,,,) IF(IOSB(1) .NE. SS$_NORMAL) THEN CALL GRWARN ('Error sending disconnect request' // : ' to task on remote node') ITEMP=IOSB(1) CALL GRGMSG(ITEMP) END IF IER=SYS$QIOW(,%val(LUN),%val(IO$_READVBLK),IOSB,,, : LIABUF,LENGTH,,,,) IF(IOSB(1) .NE. SS$_NORMAL) THEN CALL GRWARN ('Unable to read Liacom free message' // : ' from task on remote node') WRITE(6,*) IOSB(2), ' bytes read' ITEMP=IOSB(1) CALL GRGMSG(ITEMP) END IF IF(LIABUF .NE. IREC) THEN WRITE(*,500) 'Wrong data read from remote task ', : IREC, ' expected, ',LIABUF,' read' 500 FORMAT(1X,A,Z6,A) END IF RETURN END Begin Picture. 110 ITMP(1)='1088'x ! Select cursor ITMP(2)='7000'x ! Cursor off ITMP(3)='103F'x ! Select all bit planes ITMP(4)='700F'x ! Set video blank to open (display on) ITMP(5)='1010'x+ICOL ! Select planes corresponding to color CALL GRGE02(ITMP,10,%val(IBADR),ICNT,MXCNT) CALL GRGE03(%val(IBADR),ICNT) IFpgplot/drivers/old/lidriv.html010064400040640000322000000013550613473752300171630ustar00tjpcitmbr00000400000017 LIDRIV

Liacom Image Device

Supported device
Liacom Graphic Video Display (GVD-02).
Device type code
/LIacom.
Default device name
LIACOM_DEVICE (a logical name).
Default view surface dimensions
Depends on monitor.
Resolution
The full view surface is 512 by 512 pixels.
Color capability
Color indices 0--15 are supported. The representation of all color indices can be changed. Color indices 128--255 map into the second row of bit planes and support 15 levels of grey scale.
Input capability
Cursor is a fat white cross.
Author
A. F. Tennant, 1988.
pgplot/drivers/old/svdriv.c010064400040640000322000000345060513761440600164650ustar00tjpcitmbr00000400000017/************************************************************************ * * svdriv -- SunView PGPLOT Driver * * Brian M Sutin, May 19, 1989 -- first version * Brian M Sutin, July 25, 1989 -- added arbitrary sized windows * Jim Morgan, Jan 8, 1991 -- arbitrary separator in size. * Sam Southard, Apr 30, 1991 -- Modified for sharable libraries. * Tim Pearson, Jan 23, 1991 -- Remove prompt on exit. * * This driver handles the following capabilities: * * arbitrary sized view surface * 32 colors, 16 pre-defined * white background * buffering * a fully working cursor, with values returned for the mouse buttons * fast polygon and rectangle fill * * The device can be specfied by: * * "/sunview" --> 7.8" x 7.8" window (640x640) * "X/sunview" --> X" x X" window * "X,Y/sunview" --> X" x Y" window * * X and Y are floating or integers, and have intelligent defaults. * The comma can be replaced by any non-numeric character. * */ /* * dev_name -- the PGPLOT device name * */ extern char sv_dev_name[] ; /* * SCALE -- the number of pixels per inch * * This value is only good for typical Sun workstations, and will * result in a teeny window on high resolution workstations. Suns * are also slightly non-square, resulting in the X and Y scales * each being off from 82 by about 1 pixel in opposite directions. * */ #define SCALE 82 /* * DEF_*_WID -- default size of the screen * */ #define DEF_X_WID 640 #define DEF_Y_WID 640 /* * MAX_*_WID -- maximum size of the screen * */ #define MAX_X_WID 1152 #define MAX_Y_WID 900 /* * MIN_*_WID -- minimum size of the screen * */ #define MIN_X_WID 50 #define MIN_Y_WID 50 /* * *_WID -- size of the screen * */ int X_WID = DEF_X_WID ; int Y_WID = DEF_Y_WID ; /* * FLIPY -- flip Y coordinate * */ #define FLIPY(x) ( Y_WID - 1 - (x) ) extern int sv_COLOR ; /* current pen color */ extern int sv_APPEND ; /* to erase or not */ /* * NCOLOR -- number of colors * * PGPLOT predefines 16 colors, and suntools uses the last color * for the cursor color, so the next factor of two (32) was used. * Using a large number such as 256 will crowd the Sun color lookup * table and cause strange behaviour with multiple windows. * */ #define NCOLOR 32 /* The pre-defined dark grey color is too dark */ extern unsigned char sv_R_table[NCOLOR] ; extern unsigned char sv_G_table[NCOLOR] ; extern unsigned char sv_B_table[NCOLOR] ; /* * These variables are used for the Suntools polygon fill routine * */ extern int sv_NPOLY , sv_POLY ; static int VERTEX[2048] ; unsigned char GR_cursor() ; /* get character at cursor */ void svdriv_( FUNC, BUFFER, NBUF, STRING, NSTR, len ) int *FUNC ; /* function */ float *BUFFER ; /* floating data */ int *NBUF ; /* length of BUFFER */ char *STRING ; /* character data */ int *NSTR ; /* length of STRING */ int len ; /* string length */ { int i ; int xpos, ypos ; float REQ_X_WID, REQ_Y_WID ; /* requested widths */ *NBUF = 0 ; *NSTR = 0 ; switch( *FUNC ) { /* *************** return device name ************************************* */ case 1: strcpy( STRING, sv_dev_name ) ; *NSTR = strlen( sv_dev_name ) ; for( i = *NSTR ; i < len ; i++ ) STRING[i] = ' ' ; break ; /* *************** return minimum range of view surface and color index *** */ case 2: BUFFER[0] = 0 ; /* minimum X value */ BUFFER[1] = X_WID - 1 ; /* maximum X value */ BUFFER[2] = 0 ; /* minimum Y value */ BUFFER[3] = Y_WID - 1 ; /* maximum Y value */ BUFFER[4] = 0 ; /* minimum color value */ BUFFER[5] = NCOLOR - 1 ; /* maximum color value */ *NBUF = 6 ; break ; /* *************** return device scale ************************************ */ case 3: BUFFER[0] = SCALE ; /* X units per inch */ BUFFER[1] = SCALE ; /* Y units per inch */ /* * The true pen with is, of course, 1 pixel, or 1.0 in device * coordinates, but this fails miserably for PGPLOT. A smaller * pen width helps somewhat, but I have not twiddled this parameter * enough to find the best value. the /CGI interface has similar * problems. * */ /* should really be 1.0 */ BUFFER[2] = 0.2 ; /* pen width */ *NBUF = 3 ; break ; /* *************** return device capabilities ***************************** */ case 4: STRING[0] = 'I' ; /* interactive device */ STRING[1] = 'C' ; /* cursor is available */ STRING[2] = 'N' ; /* no dashed lines */ STRING[3] = 'A' ; /* polygon fill available */ STRING[4] = 'N' ; /* T */ /* fat lines */ STRING[5] = 'R' ; /* rectangle fill available */ STRING[6] = 'N' ; /* not used */ STRING[7] = 'V' ; /* window lost on exit */ STRING[8] = 'N' ; /* not used */ STRING[9] = 'N' ; /* not used */ *NSTR = 10 ; break ; /* *************** return default device/file name ************************ */ case 5: STRING[0] = ' ' ; /* no default name */ break ; /* *************** return default size of view **************************** */ case 6: BUFFER[0] = 0 ; /* default X min */ BUFFER[1] = X_WID - 1 ; /* default X max */ BUFFER[2] = 0 ; /* default Y min */ BUFFER[3] = Y_WID - 1 ; /* default Y max */ *NBUF = 4 ; break ; /* *************** return miscellaneous defaults ************************** */ case 7: BUFFER[0] = 2.0 ; /* return a random number */ *NBUF = 1 ; break ; /* *************** select device ****************************************** */ case 8: /* do nothing */ break ; /* *************** open workstation *************************************** */ case 9: BUFFER[0] = 0.0 ; /* return channel 0 */ BUFFER[1] = 1.0 ; /* always successful open */ if( BUFFER[2] ) /* no-erase mode */ sv_APPEND = 1 ; else sv_APPEND = 0 ; *NBUF = 2 ; /* i = sscanf( STRING, "%f,%f", &REQ_X_WID, &REQ_Y_WID ) ; */ i = sscanf( STRING, "%f%*c%f", &REQ_X_WID, &REQ_Y_WID ) ; if( i == 1 ) { REQ_Y_WID = REQ_X_WID ; i = 2 ; } if( i == 2 ) { REQ_X_WID *= SCALE ; /* scale inches to pixels */ REQ_Y_WID *= SCALE ; /* scale inches to pixels */ if( REQ_X_WID < MIN_X_WID ) REQ_X_WID = DEF_X_WID ; if( REQ_X_WID > MAX_X_WID ) REQ_X_WID = MAX_X_WID - MIN_X_WID ; if( REQ_Y_WID < MIN_Y_WID ) REQ_Y_WID = DEF_Y_WID ; if( REQ_Y_WID > MAX_Y_WID ) REQ_Y_WID = MAX_Y_WID - MIN_Y_WID ; X_WID = REQ_X_WID ; Y_WID = REQ_Y_WID ; } GR_start() ; GR_batch(1) ; break ; /* *************** close workstation ************************************** */ case 10: GR_batch(0) ; break ; /* *************** begin picture ****************************************** */ case 11: GR_batch(1) ; if( !sv_APPEND ) /* erase screen */ GR_rectangle( 0, 0, X_WID-1, Y_WID-1, 0 ) ; break ; /* *************** draw line ********************************************** */ case 12: GR_vector( (int) BUFFER[0], (int) BUFFER[1], (int) BUFFER[2], (int) BUFFER[3], sv_COLOR ) ; break ; /* *************** draw dot *********************************************** */ case 13: GR_vector( (int) BUFFER[0], (int) BUFFER[1], (int) BUFFER[0], (int) BUFFER[1], sv_COLOR ) ; break ; /* *************** end picture ******************************************** */ case 14: #ifdef CORRECT_END if( BUFFER[0] ) GR_rectangle( 0, 0, X_WID-1, Y_WID-1, 0 ) ; #endif CORRECT_END GR_batch(0) ; break ; /* *************** set color index **************************************** */ case 15: sv_COLOR = BUFFER[0] ; break ; /* *************** flush buffer ******************************************* */ case 16: GR_batch(0) ; GR_batch(1) ; break ; /* *************** read cursor ******************************************** */ case 17: GR_batch(0) ; xpos = BUFFER[0] ; ypos = FLIPY( BUFFER[1] ) ; STRING[0] = GR_cursor( &xpos, &ypos, "PGPLOT cursor input..." ) ; BUFFER[0] = xpos ; BUFFER[1] = FLIPY( ypos ) ; *NBUF = 2 ; *NSTR = 1 ; GR_batch(1) ; break ; /* *************** erase alpha screen ************************************* */ case 18: /* no alpha screen to erase */ break ; /* *************** set line style ***************************************** */ case 19: *NBUF = -1 ; /* let pgplot do it */ break ; /* *************** polygon fill ******************************************* */ case 20: if( sv_POLY == 0 ) { sv_NPOLY = BUFFER[0] ; sv_POLY = 2 * sv_NPOLY ; } else { VERTEX[--sv_POLY] = FLIPY( BUFFER[1] ) ; VERTEX[--sv_POLY] = BUFFER[0] ; if( sv_POLY == 0 ) GR_poly( sv_NPOLY, VERTEX, sv_COLOR ) ; } break ; /* *************** set color represention ********************************* */ case 21: i = BUFFER[0] ; sv_R_table[i] = 255.9 * BUFFER[1] ; sv_G_table[i] = 255.9 * BUFFER[2] ; sv_B_table[i] = 255.9 * BUFFER[3] ; GR_color(i) ; break ; /* *************** set line width ***************************************** */ case 22: *NBUF = -1 ; /* no fat lines */ break ; /* *************** escape function **************************************** */ case 23: /* no escape functions */ break ; /* *************** rectangle fill ***************************************** */ case 24: GR_rectangle( (int) BUFFER[0], (int) BUFFER[1], (int) BUFFER[2], (int) BUFFER[3], sv_COLOR ) ; break ; /* *************** future unknown functions ******************************* */ default: *NBUF = -1 ; break ; } } /************************************************************************ * * * Suntools Dependent Garbage * * * ************************************************************************/ #include #include #include #include Frame frame ; Canvas canvas ; Pixwin *pw ; GR_start() { static struct itimerval tvalue = { { 0, 100000 }, /* 0.1 second interval */ { 0, 100000 } /* 0.1 second value */ } ; static update() ; /* update screen */ static gr_events() ; /* interrupt handler */ Notify_value gr_quit() ; /* quit handler */ frame = window_create(NULL, FRAME, FRAME_LABEL, "PGPLOT", WIN_ERROR_MSG, "Cannot create window", FRAME_SUBWINDOWS_ADJUSTABLE, FALSE, 0) ; canvas = window_create(frame, CANVAS, CANVAS_RETAINED, FALSE, WIN_WIDTH, X_WID, WIN_HEIGHT, Y_WID, WIN_EVENT_PROC, gr_events, 0) ; pw = (Pixwin *) window_get(canvas, CANVAS_PIXWIN) ; pw_setcmsname( pw, "PGPLOT" ) ; pw_putcolormap( pw, 0, NCOLOR, sv_R_table, sv_G_table, sv_B_table ) ; window_set( canvas, CANVAS_RETAINED, TRUE, 0 ) ; window_fit(frame) ; window_set( frame, WIN_SHOW, TRUE, 0 ) ; (void) notify_interpose_destroy_func( frame, gr_quit ) ; (void) notify_dispatch() ; /* set up signal catching */ signal( SIGALRM, update ) ; /* intercept alarm signals */ setitimer( 0, &tvalue, 0 ) ; /* set up our own timer */ } Notify_value gr_quit( client, status ) Notify_client client ; Destroy_status status ; { if( status != DESTROY_CHECKING ) exit(1) ; return notify_next_destroy_func( client, status ) ; } static update( sig, code, scp ) int sig, code ; struct sigcontext *scp ; { (void) notify_dispatch() ; /* update the screen */ } /************************************************************************ * * * Graphics Routines * * * ************************************************************************/ GR_rectangle( x_lo, y_lo, x_hi, y_hi, color ) int x_lo, y_lo, x_hi, y_hi, color ; { pw_rop( pw, x_lo, FLIPY(y_hi), x_hi - x_lo, y_hi - y_lo, PIX_SRC | PIX_COLOR(color), 0, 0, 0 ) ; } GR_vector( x1, y1, x2, y2, color ) int x1, y1, x2, y2, color ; { pw_vector( pw, x1, FLIPY(y1), x2, FLIPY(y2), PIX_SRC | PIX_COLOR(color), 0 ) ; } GR_poly( npoly, vertex, color ) int npoly, color ; int *vertex ; { int i ; /* pw_batch_on(pw) ; */ pw_polygon_2( pw, 0, 0, 1, &npoly, vertex, PIX_SRC | PIX_COLOR(color), 0, 0, 0 ) ; for( i = 0 ; i < npoly-1 ; i++ ) pw_vector( pw, vertex[2*i], vertex[2*i+1], vertex[2*i+2], vertex[2*i+3], PIX_SRC | PIX_COLOR(color), 0 ) ; pw_vector( pw, vertex[2*i], vertex[2*i+1], vertex[0], vertex[1], PIX_SRC | PIX_COLOR(color), 0 ) ; /* pw_batch_off(pw) ; */ } GR_color(c) int c ; { pw_putcolormap( pw, c, 1, &sv_R_table[c], &sv_G_table[c], &sv_B_table[c] ) ; } GR_batch(state) int state ; { static int STATE = 0 ; if( state == STATE ) return ; if( state ) pw_batch_on(pw) ; else pw_batch_off(pw) ; STATE = state ; } /************************************************************************ * * * GR_cursor -- Wait for Events * * * ************************************************************************/ int x_cursor, y_cursor ; unsigned char c_cursor ; unsigned char GR_cursor( x, y, string ) int *x, *y ; char *string ; { static struct timeval tvalue = { 0, 100000, /* 0.1 second interval */ } ; x_cursor = -1 ; y_cursor = -1 ; c_cursor = 0xff ; window_set( canvas, WIN_CONSUME_KBD_EVENTS, /* enable events */ WIN_ASCII_EVENTS, WIN_LEFT_KEYS, /* KEYS are here to remove */ WIN_RIGHT_KEYS, /* escape sequence definition */ WIN_TOP_KEYS, 0, WIN_MOUSE_XY, /* must be after KEYS, or will */ *x, *y, /* not highlight border correctly */ 0 ) ; window_set( frame, FRAME_LABEL, string, 0 ) ; while( c_cursor == 0xff ) select( 0, 0, 0, 0, &tvalue ) ; /* wait until character */ window_set( canvas, /* disable events */ WIN_IGNORE_KBD_EVENTS, WIN_ASCII_EVENTS, WIN_LEFT_KEYS, /* KEYS are here to remove */ WIN_RIGHT_KEYS, /* escape sequence definition */ WIN_TOP_KEYS, 0, 0 ) ; window_set( frame, FRAME_LABEL, "PGPLOT", 0 ) ; *x = x_cursor ; *y = y_cursor ; return c_cursor ; } /************************************************************************ * * * gr_events -- Interrupt Handler * * * ************************************************************************/ static gr_events( win, event, arg ) Canvas win ; Event *event ; caddr_t arg ; { int id ; float w_save, h_save ; id = event_id(event) ; x_cursor = event_x(event) ; /* position */ y_cursor = event_y(event) ; if( event_is_ascii(event) ) /* keyboard */ c_cursor = id ; else if( event_is_button(event) ) { /* mouse keys */ c_cursor = 128 + 2 * ( id - BUT(1) ) ; if( event_is_up(event) ) c_cursor++ ; } else /* everything else */ return ; } pgplot/drivers/old/imdriv.html010064400040640000322000000020600613474016200171470ustar00tjpcitmbr00000400000017 IMDRIV, VIDRIV

Impress (Imagen) Devices

Supported device
any Imagen printer that accepts the Impress page description language.
Device type code
/IMPRESS (landscape mode), /VIPRESS (portrait mode).
Default file name
PGPLOT.IMPLOT, PGPLOT.VIPLOT.
Default view surface dimensions
10.25 inches horizontal by 7.75 inches vertical (landscape mode).
Resolution
the driver uses coordinate increments of 1/300 inch. The true resolution is device-dependent.
Color capability
color indices 0 (erase), and 1 (black) are supported. Requests for other color indices are converted to 1. It is not possible to change color representation.
Input capability
none.
File format
binary, variable length records (max 1024 bytes); no carriage control.
Obtaining hardcopy
(VMS) $ IMPRINT/IMPRESS file.type.
Author
T. J. Pearson, 1987.
pgplot/drivers/old/irdriv.html010064400040640000322000000025350576367076700172070ustar00tjpcitmbr00000400000017 IRDRIV

SGI/IRIX Workstation

Note
This device driver is for workstations running the Silicon Graphics IRIX operating system. It makes use of the SGI GL library (you need to include this library when linking PGPLOT programs that use this driver: use, e.g., -lgl_s). Most users will prefer to use the X-Window driver (/XWIN or /XSERV), which works correctly on IRIX workstations.
Supported device
IRIS 4D workstation. This driver handles the following capabilities: arbitrary sized view surface, 32 colors, 16 pre-defined, white background, buffering, a fully working cursor, with values returned for the mouse buttons, fast polygon and rectangle fill.
Device type code
/IRIS gives a 7.8 by 7.8-inch window (640 by 640 pixels); x/IRIS gives a square window, x by x inches; x,y/IRIS gives a rectangular window, x by y inches. x and y can be integers or decimal numbers.
Bugs
This driver does not report the position of the cursor correctly unless the window is in the very bottom left of the screen. This and other bugs are unlikely to be corrected: you should use the X-window driver instead.
Author
Stephen Green, 1990.
pgplot/drivers/old/svdriv.html010064400040640000322000000016250571677436000172140ustar00tjpcitmbr00000400000017 SVDRIV

Sun Workstations Running SunView

Supported device
Sun workstations running SunView. This driver handles the following capabilities: arbitrary sized view surface, 32 colors, 16 pre-defined, white background, buffering, a fully working cursor, with values returned for the mouse buttons, fast polygon and rectangle fill. Note that SunView is not supported under the current Solaris operating system: use the X Window driver instead
Device type code
/SUNVIEW gives a 7.8 by 7.8-inch window (640 by 640 pixels);
x/SUNVIEW gives a square window, x x x inches;
x,y/SUNVIEW gives a rectangular window, x x y inches.
x and y can be integers or decimal numbers.
Author
Brian M. Sutin, Jim Morgan, T. J. Pearson, Sam Southard.
pgplot/drivers/xmotif/XmPgplot.c010064400040640000322000002000510650112260600174300ustar00tjpcitmbr00000400000017/* * Changes: * * 17 March 97 - The XmNTraversalOn resource was being ignored by the * cursor event-handler. Thus Tab characters and * the first ButtonPress after loss of input-focus were * interpretted as focus control events. This has now * been remedied. When XmNTraversalOn is False these * events are now treated as normal input events. */ /* Motif pgplot widget class implementation */ #include #include #include #include #include #include #include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow xmdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call xmdriv() or xmdriv_(). */ #ifdef PG_PPU #define XMDRIV xmdriv_ #else #define XMDRIV xmdriv #endif #include "XmPgplotP.h" /* * Define the default attributes of the widget. */ #define XMP_MIN_WIDTH 64 /* Minimum width (pixels) */ #define XMP_MIN_HEIGHT 64 /* Minimum height (pixels) */ #define XMP_DEF_WIDTH 256 /* Default width (pixels) */ #define XMP_DEF_HEIGHT 256 /* Default height (pixels) */ #define XMP_MIN_COLORS 2 /* Min number of colors per colormap */ #define XMP_DEF_COLORS 100 /* Default number of colors to try for */ #define XMP_MAX_COLORS 255 /* Max number of colors per colormap */ #define XMP_DEF_MARGIN 20 /* The number of pixels to assign to the margin */ #define XMP_DEF_SHARE 0 /* Default to allocating shared colors */ /* * Specify the name to prefix errors with. */ #define XMP_IDENT "PgplotWidget" static void xmp_GetDefaultHighlightColor(Widget widget, int offset, XrmValue *value); static void xmp_GetDefaultBackgroundColor(Widget widget, int offset, XrmValue *value); static void xmp_GetDefaultForegroundColor(Widget widget, int offset, XrmValue *value); /* * Define all the X resources that are to be understood by the * widget. */ static XtResource resources[] = { { XmpNminColors, XmpCMinColors, XtRInt, sizeof(int), XtOffsetOf(XmPgplotRec, pgplot.min_colors), XtRImmediate, (XtPointer) XMP_MIN_COLORS }, { XmpNmaxColors, XmpCMaxColors, XtRInt, sizeof(int), XtOffsetOf(XmPgplotRec, pgplot.max_colors), XtRImmediate, (XtPointer) XMP_DEF_COLORS }, { XmNvisual, XmCVisual, #if XmVersion <= 1001 XtRVisual, #else XmRVisual, #endif sizeof(Visual *), XtOffsetOf(XmPgplotRec, pgplot.visual), XtRImmediate, (XtPointer) CopyFromParent }, { XmNresizeCallback, XmCCallback, XmRCallback, sizeof(XtCallbackList), XtOffsetOf(XmPgplotRec, pgplot.resize_callback), XmRImmediate, (XtPointer) NULL }, { XmNhighlightColor, XmCHighlightColor, XmRPixel, sizeof(Pixel), XtOffsetOf(XmPgplotRec, primitive.highlight_color), XmRCallProc, (XtPointer) xmp_GetDefaultHighlightColor }, { XmNbackground, XmCBackground, XmRPixel, sizeof(Pixel), XtOffsetOf(XmPgplotRec, core.background_pixel), XmRCallProc, (XtPointer) xmp_GetDefaultBackgroundColor }, { XmNforeground, XmCForeground, XmRPixel, sizeof(Pixel), XtOffsetOf(XmPgplotRec, primitive.foreground), XmRCallProc, (XtPointer) xmp_GetDefaultForegroundColor }, { XmpNpadX, XmpCPadX, XtRDimension, sizeof(Dimension), XtOffsetOf(XmPgplotRec, pgplot.pad_x), XtRImmediate, (XtPointer) XMP_DEF_MARGIN }, { XmpNpadY, XmpCPadY, XtRDimension, sizeof(Dimension), XtOffsetOf(XmPgplotRec, pgplot.pad_y), XtRImmediate, (XtPointer) XMP_DEF_MARGIN }, { XmpNshare, XmpCShare, XtRBoolean, sizeof(Boolean), XtOffsetOf(XmPgplotRec, pgplot.share), XtRImmediate, (XtPointer) XMP_DEF_SHARE }, }; /* * Declare class method functions. */ static void xmp_ClassPartInit(WidgetClass w); static void xmp_Initialize(Widget request, Widget new_w, ArgList args, Cardinal *num_args); static void xmp_Realize(Widget widget, XtValueMask *mask, XSetWindowAttributes *attributes); static void xmp_Resize(Widget widget); static void xmp_Destroy(Widget widget); static void xmp_Expose(Widget widget, XEvent *event, Region region); static Boolean xmp_SetValues(Widget old_widget, Widget req_widget, Widget new_widget, ArgList args, Cardinal *num_args); static XtGeometryResult xmp_Query_Geometry(Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *reply); static void XmpDestroyParentCallback(Widget w, XtPointer client_data, XtPointer call_data); /* * Actions and their default translations should go here. * Note that specifying NULL for for the core.tm_table class * field results in the Motif Primitive initialization function * not augmenting the table with its keyboard traversal translations. * Thus we must supply a translation table, even if it is empty. */ static char default_translations[] = ""; /* * Define the Motif Pgplot class shared context descriptor. */ externaldef(xmpgplotclassrec) XmPgplotClassRec xmPgplotClassRec = { { /* core_class fields */ /* superclass */ (WidgetClass) &xmPrimitiveClassRec, /* class_name */ "XmPgplot", /* widget_size */ sizeof(XmPgplotRec), /* class_initialize */ NULL, /* class_part_initiali*/ xmp_ClassPartInit, /* class_inited */ FALSE, /* initialize */ xmp_Initialize, /* initialize_hook */ NULL, /* realize */ xmp_Realize, /* actions */ NULL, /* num_actions */ 0, /* resources */ resources, /* num_resources */ XtNumber(resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, /* compress_exposure */ XtExposeCompressMultiple, /* compress_enterleave*/ TRUE, /* visible_interest */ FALSE, /* destroy */ xmp_Destroy, /* resize */ xmp_Resize, /* expose */ xmp_Expose, /* set_values */ xmp_SetValues, /* set_values_hook */ NULL, /* set_values_almost */ XtInheritSetValuesAlmost, /* get_values_hook */ NULL, /* accept_focus */ NULL, /* version */ XtVersion, /* callback_private */ NULL, /* tm_table */ default_translations, /* query_geometry */ xmp_Query_Geometry, /* display accel */ XtInheritDisplayAccelerator, /* extension */ NULL }, { /* primitive_class fields */ /* border_highlight */ (XtWidgetProc) _XtInherit, /* border_unhighlight */ (XtWidgetProc) _XtInherit, /* translations */ XtInheritTranslations, /* arm_and_activate */ NULL, /* syn resources */ NULL, /* num get_resources */ 0, /* extension */ NULL }, { /* Pgplot class fields */ /* widget_id_counter */ 0, /* active_widgets */ {NULL}, /* free_widgets */ {NULL}, /* Extension */ NULL } }; /* * Declare a global class pointer for use in XtCreateManagedWidget * calls. */ externaldef(xmpgplotwidgetclass) WidgetClass xmPgplotWidgetClass = (WidgetClass) &xmPgplotClassRec; /* * Private functions. */ static void xmp_abort(XmPgplotPart *xmp, char *msg); static XmPgplotWidget xmp_open_widget(char *name); static XmPgplotWidget xmp_close_widget(char *name); static void xmp_update_scroll_bars(XmPgplotWidget w); static void xmp_update_clip(XmPgplotWidget w); static void xmp_NewPixmap(PgxWin *pgx, unsigned width, unsigned height); static void xmp_scroll_callback(Widget widget, XtPointer client_data, XtPointer call_data); static void xmp_CursorHandler(Widget widget, XtPointer client_data, XEvent *event, Boolean *cont); static int xmp_ArmCursor(XmPgplotWidget w, int mode, float xref, float yref, XtCallbackProc callback, void *client_data); static int xmp_DisarmCursor(XmPgplotWidget w); static int xmp_new_visual(XmPgplotWidget w); static int xmp_WorldToPixel(XmPgplotWidget w, float wx, float wy, int *px, int *py); static int xmp_PixelToWorld(XmPgplotWidget w, int px, int py, float *wx, float *wy); /* Enumerate the PGPLOT class widget lists */ #define XMP_ACTIVE_WIDGETS 1 #define XMP_FREE_WIDGETS 2 static XmPgplotList *xmp_WidgetList(int type); static XmPgplotWidget xmp_FindWidgetByName(char *name, int type, XmPgplotWidget *prev); static XmPgplotWidget xmp_FindWidgetByID(int xmslct_id, int type, XmPgplotWidget *prev); static XmPgplotWidget xmp_RemoveWidget(char *name, int type); static XmPgplotWidget xmp_PrependWidget(XmPgplotWidget w, int type); static XmPgplotWidget xmp_CurrentWidget(char *context); /*....................................................................... * This is called once to initialize the PGPLOT part of the widget class * structure when the first widget instance of this type is created. * * Input: * w WidgetClass The class record to be initialized. */ static void xmp_ClassPartInit(WidgetClass w) { XmPgplotWidgetClass class = (XmPgplotWidgetClass) w; XmPgplotClassPart *pgplot = &class->pgplot_class; pgplot->widget_id_counter = 0; pgplot->active_widgets.head = NULL; pgplot->free_widgets.head = NULL; pgplot->extension = NULL; return; } /*....................................................................... * This is called to check resource derived defaults and initialize * a PGPLOT widget instance. * * Input: * request Widget The instance widget type with the resource values * requested by the client. * new_w Widget The resulting instance widget with allowed * resource values. * args ArgList The widget-creation argument list used to override * default values. * num_args Cardinal The number of arguments in args. */ static void xmp_Initialize(Widget request, Widget new_w, ArgList args, Cardinal *num_args) { XmPgplotWidget w = (XmPgplotWidget) new_w; XmPgplotPart *xmp = &w->pgplot; /* * Initialize the private attributes. */ xmp->next = NULL; xmp->xmslct_id = xmPgplotClassRec.pgplot_class.widget_id_counter++; xmp->pgslct_id = 0; /* This is filled in by the first select-plot opcode */ xmp->device = NULL; xmp->app = XtWidgetToApplicationContext(new_w); xmp->scroll.is_scrolled = 0; xmp->scroll.w_hbar = NULL; xmp->scroll.w_vbar = NULL; xmp->scroll.width = 0; xmp->scroll.height = 0; xmp->scroll.x = 0; xmp->scroll.y = 0; xmp->input.mask = 0; xmp->input.callback = 0; xmp->input.client_data = NULL; xmp->bg.red = xmp->bg.green = xmp->bg.blue = 0; xmp->fg.red = xmp->fg.green = xmp->fg.blue = 65535; xmp->pgx = NULL; /* * Record the RGB values of the default background and foreground * colors. */ XtVaGetValues(new_w, XtVaTypedArg, XmNbackground, XmRColor, &xmp->bg, sizeof(xmp->bg), XtVaTypedArg, XmNforeground, XmRColor, &xmp->fg, sizeof(xmp->fg), NULL); /* * Allocate the PGPLOT-window context descriptor. */ xmp->pgx = new_PgxWin(XtDisplay(new_w), XScreenNumberOfScreen(XtScreen(new_w)), (void *) w, XtName(new_w), 0, xmp_NewPixmap); if(!xmp->pgx) xmp_abort(xmp, NULL); /* * Compose a sample PGPLOT device-specification for use in opening this * widget to PGPLOT. */ xmp->device = (char *) malloc(sizeof(char) * (strlen(xmp->pgx->name) + 1 + strlen(XMP_DEVICE) + 1)); if(!xmp->device) xmp_abort(xmp, "Insufficient memory.\n"); sprintf(xmp->device, "%s/%s", xmp->pgx->name, XMP_DEVICE); /* * Check the widget size. */ if(w->core.width==0) w->core.width = XMP_DEF_WIDTH; if(w->core.height==0) w->core.height = XMP_DEF_HEIGHT; if(w->core.width < XMP_MIN_WIDTH) w->core.width = XMP_MIN_WIDTH; if(w->core.height < XMP_MIN_HEIGHT) w->core.height = XMP_MIN_HEIGHT; /* * Check color resources. */ if(xmp->min_colors < XMP_MIN_COLORS) xmp->min_colors = XMP_MIN_COLORS; if(xmp->max_colors > XMP_MAX_COLORS) xmp->max_colors = XMP_MAX_COLORS; /* * See if the parent widget is a scrolled window. */ if(XtIsSubclass(XtParent(new_w), xmScrolledWindowWidgetClass)) { Widget w_scroll = XtParent(new_w); XmpScroll *scroll = &xmp->scroll; scroll->is_scrolled = 1; scroll->width = w->core.width; scroll->height = w->core.height; scroll->w_hbar = XtVaCreateManagedWidget("hbar", xmScrollBarWidgetClass, w_scroll, XmNorientation, XmHORIZONTAL, XmNminimum, 0, XmNmaximum, scroll->width, XmNsliderSize, scroll->width, XmNpageIncrement, scroll->width, XmNincrement, 1, NULL); XtAddCallback(scroll->w_hbar, XmNvalueChangedCallback, xmp_scroll_callback, w); XtAddCallback(scroll->w_hbar, XmNdragCallback, xmp_scroll_callback, w); scroll->w_vbar = XtVaCreateManagedWidget("vbar", xmScrollBarWidgetClass, w_scroll, XmNorientation, XmVERTICAL, XmNminimum, 0, XmNmaximum, scroll->height, XmNsliderSize, scroll->height, XmNpageIncrement, scroll->height, XmNincrement, 1, NULL); XtAddCallback(scroll->w_vbar, XmNvalueChangedCallback, xmp_scroll_callback, w); XtAddCallback(scroll->w_vbar, XmNdragCallback, xmp_scroll_callback, w); XmScrolledWindowSetAreas(w_scroll, scroll->w_hbar, scroll->w_vbar, new_w); }; return; } /*....................................................................... * Create and clear the window of a PGPLOT widget instance. * * Input: * widget Widget The widget to be realized. * mask XtValueMask * The bit-mask that specifies which * attributes have been set in 'attr'. * attr XSetWindowAttributes * The container of the pre-set window * attributes specified in 'mask'. */ static void xmp_Realize(Widget widget, XtValueMask *mask, XSetWindowAttributes *attr) { XmPgplotWidget w = (XmPgplotWidget) widget; XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; /* * Get a visual and colormap for the window if necessary. */ if(!pgx->color) { if(!xmp->share && xmp_new_visual(w)) /* If requested try private first */ xmp->share = 1; if(xmp->share && xmp_new_visual(w)) { /* Try for shared colors */ fprintf(stderr, "%s: There are insufficient colors, so black and white will be used.\n", XMP_IDENT); if(!pgx_bw_visual(pgx)) xmp_abort(xmp, "No colors.\n"); }; }; /* * Keep the resource-value record of the chosen visual and colormap * in sync with the values in pgx->color. */ xmp->visual = pgx->color->vi->visual; w->core.colormap = pgx->color->cmap; /* * Reset the background and foreground colors to match the current * X resource values. */ pgx_set_background(pgx, &xmp->bg); pgx_set_foreground(pgx, &xmp->fg); /* * The window attributes passed to this function are based on * attributes stored in the core record of the widget instance. * By default these attributes (set by X resources) cause the * new window to inherit colormap, depth, etc.. from the parent * window. Since the call to pgx_new_visual() may have invalidated this * we need to install new values. This involves both updating the * window attributes to be passed to XtCreateWindow() and modifying * the X resources of the core part of the instance structure. * * It is important to remember that the border and background pixmaps * need to be changed to avoid mismatches between their depths and the * depth of our chosen visual. To avoid such conflicts we will make sure * that pixmaps are not used and substitute solid colors. */ /* * Add and remove appropriate window attributes. */ *mask |= CWDontPropagate | CWBackPixel | CWBorderPixel | CWColormap; *mask &= ~(CWBackPixmap | CWBorderPixmap); attr->do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask | KeyPressMask | KeyReleaseMask; attr->background_pixel = xmp->pgx->color->pixel[0]; attr->border_pixel = xmp->pgx->color->pixel[0]; attr->colormap = w->core.colormap; /* * Record the new attributes in the core part of the instance record. */ XtVaSetValues(widget, XmNbackground, xmp->pgx->color->pixel[0], XmNborderColor, xmp->pgx->color->pixel[0], XmNdepth, xmp->pgx->color->vi->depth, NULL); /* * Create the window. */ XtCreateWindow(widget, InputOutput, xmp->visual, *mask, attr); pgx->window = XtWindow(widget); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ { XGCValues gcv; gcv.graphics_exposures = False; pgx_start_error_watch(pgx); pgx->expose_gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCGraphicsExposures), &gcv); if(pgx_end_error_watch(pgx) || pgx->expose_gc==NULL) xmp_abort(xmp, "Failed to allocate a graphical context.\n"); }; /* * If the widget has scroll-bars make sure that they agree with the * window. */ xmp_update_scroll_bars(w); xmp_update_clip(w); /* * Prepend the new widget to the list of unassigned widgets to be * used by pgbeg(). */ xmp_PrependWidget(w, XMP_FREE_WIDGETS); return; } /*....................................................................... * PGPLOT Widget destructor function. * * Input: * widget Widget The widget whose resources are to be released. */ static void xmp_Destroy(Widget widget) { XmPgplotWidget w = (XmPgplotWidget) widget; XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; /* * Remove the device from the appropriate list of PGPLOT Motif widgets. */ xmp_RemoveWidget(pgx->name, pgx->state ? XMP_ACTIVE_WIDGETS : XMP_FREE_WIDGETS); /* * Delete the window context descriptor. */ xmp->pgx = del_PgxWin(pgx); return; } /*....................................................................... * PGPLOT Widget resize function. * * Input: * widget Widget The widget that is being resized. */ static void xmp_Resize(Widget widget) { XmPgplotWidget w = (XmPgplotWidget) widget; xmp_update_clip(w); if(XtIsRealized(widget)) { w->pgplot.scroll.x = 0; w->pgplot.scroll.y = 0; xmp_update_scroll_bars(w); XtCallCallbackList(widget, w->pgplot.resize_callback, (XtPointer *)0); }; } /*....................................................................... * The expose-event handler for PGPLOT widgets. * * Input: * widget Widget The widget that is to be re-drawn. * event XEvent The expose event that invoked the callback. * region Region The area to be re-drawn. */ static void xmp_Expose(Widget widget, XEvent *event, Region region) { XmPgplotWidget w = (XmPgplotWidget) widget; XmPgplotPart *xmp = &w->pgplot; XmPgplotWidgetClass class = (XmPgplotWidgetClass) XtClass(widget); PgxWin *pgx = xmp->pgx; /* * Re-draw highlight border. */ if(w->primitive.highlighted) { class->primitive_class.border_highlight(widget); } else { class->primitive_class.border_unhighlight(widget); }; pgx_expose(pgx, event); return; } /*....................................................................... * This function is called whenever one or more resource values are * changed, to give the widget a chance to re-configure itself to * reflect the new values. * * Input: * old_widget Widget A copy of the widget before the change was made. * req_widget Widget The same as new_w but with the resources evaluated * by the superclasses. * new_widget Widget The widget with the new values in place. This * is also the output widget so changes made to * this widget will be in the final widget. * args ArgList The resource argument list responsible for the * changes. * num_args Cardinal * The number of arguments in args. * Output: * return Boolean Return True if the widget needs to be re-displayed, * or False if not. */ static Boolean xmp_SetValues(Widget old_widget, Widget req_widget, Widget new_widget, ArgList args, Cardinal *num_args) { XmPgplotWidget old_w = (XmPgplotWidget) old_widget; XmPgplotWidget new_w = (XmPgplotWidget) new_widget; XmPgplotPart *old_xmp = &old_w->pgplot; XmPgplotPart *new_xmp = &new_w->pgplot; Bool redisplay_needed = False; /* * Changes to color resources won't be seen once the widget is * realized. Warn the application writer. */ if(new_xmp->min_colors != old_xmp->min_colors || new_xmp->max_colors != old_xmp->max_colors || new_xmp->share != old_xmp->share || new_w->core.colormap != old_w->core.colormap || new_xmp->visual != old_xmp->visual) { if(XtIsRealized(new_widget)) XtWarning("XtSetValues (XmPgplot): Too late to change color settings.\n"); new_xmp->min_colors = old_xmp->min_colors; new_xmp->max_colors = old_xmp->max_colors; new_xmp->share = old_xmp->share; new_w->core.colormap = old_w->core.colormap; new_xmp->visual = old_xmp->visual; }; /* * If the highlight border-thickness changed update the window * clip region to exclude the border from future pgxwin graphics. */ if(new_w->primitive.highlight_thickness != old_w->primitive.highlight_thickness) { xmp_update_clip(new_w); redisplay_needed = True; }; /* * If the background or foreground colors changed, convert them to * RGB values and instantiate the new definitions. Note that keeping * and using RGB values rather than the pixel value is important * because we may not yet have created the window or its final colormap, * in which case the pixel will correspond to the wrong colormap. The * RGB values are used hereafter by xmp_open_widget(). */ if(new_w->core.background_pixel != old_w->core.background_pixel) { XColor *bg = &new_xmp->bg; XtVaGetValues(new_widget, XtVaTypedArg, XmNbackground, XmRColor, bg, sizeof(*bg), NULL); pgx_set_background(new_xmp->pgx, bg); }; if(new_w->primitive.foreground != old_w->primitive.foreground) { XColor *fg = &new_xmp->fg; XtVaGetValues(new_widget, XtVaTypedArg, XmNforeground, XmRColor, fg, sizeof(*fg), NULL); pgx_set_foreground(new_xmp->pgx, fg); }; /* * Change the margins? */ if(new_xmp->pad_x != old_xmp->pad_x || new_xmp->pad_y != old_xmp->pad_y) pgx_set_margin(new_xmp->pgx, new_xmp->pad_x, new_xmp->pad_y); return redisplay_needed; } /*....................................................................... * Whenever the parent widget wishes to resize a PGPLOT widget, this * function is called to give the widget a chance to veto or otherwise * modify the requested new geometry. * * Input: * widget Widget The widget wrt which the geometry change * pertains. * request XtWidgetGeometry * The requested widget geometry. * Input/Output: * reply XtWidgetGeometry * The returned allowed widget geometry. * Output: * return XtGeometryResult Return status from: * XtGeometryYes * The requested geometry is acceptible. * XtGeometryAlmost * An acceptible revision of the requested * geometry has been encoded in *reply. * XtGeometryNo * The requested geometry is identical * to the existing geometry. */ static XtGeometryResult xmp_Query_Geometry(Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *reply) { /* * Tell the parent which attributes we are interested in * and set them to their current values until otherwise * requested. */ reply->request_mode = CWWidth | CWHeight; reply->width = widget->core.width; reply->height = widget->core.height; /* * Check the requested width. */ if(request->request_mode & CWWidth) { reply->width = request->width < XMP_MIN_WIDTH ? XMP_MIN_WIDTH : request->width; }; /* * Check the requested height. */ if(request->request_mode & CWHeight) { reply->height = request->height < XMP_MIN_HEIGHT ? XMP_MIN_HEIGHT : request->height; }; /* * Determine the appropriate reply. */ if((request->request_mode & (CWWidth | CWHeight)) == (CWWidth | CWHeight) && request->width == reply->width && request->height == reply->height) return XtGeometryYes; else if(reply->width == widget->core.width && reply->height == widget->core.height) return XtGeometryNo; else return XtGeometryAlmost; } /*....................................................................... * This function is called to abort the application after a fatal * error occurs. It doesn't return. * * Input: * xmp XmPgplotPart * The PGPLOT part of the widget instance structure. * msg char * An error message to abort with, or NULL. */ static void xmp_abort(XmPgplotPart *xmp, char *msg) { XtAppError(xmp->app, msg ? msg : "Aborting"); } /*....................................................................... * Find an inactive PGPLOT widget of a given name, open it to PGPLOT, * and move it to the head of the active list of widgets. * * Input: * name char * The name of the widget to be opened. * Output: * w XmPgplotWidget The selected widget, or NULL on error. */ static XmPgplotWidget xmp_open_widget(char *name) { XmPgplotWidget w; /* The PGPLOT widget to be opened */ /* * Remove the named widget from the free-widget list. */ w = xmp_RemoveWidget(name, XMP_FREE_WIDGETS); if(!w) { fprintf(stderr, "%s: Request to open non-existent widget (%s).\n", XMP_IDENT, name ? name : "(null)"); return NULL; }; /* * Pre-pend the widget to the active list. */ xmp_PrependWidget(w, XMP_ACTIVE_WIDGETS); /* * Open the connection to the PgxWin library. */ pgx_open(w->pgplot.pgx); if(!w->pgplot.pgx->state) xmp_close_widget(name); /* * Reset the background and foreground colors to match the current * X resource values. */ pgx_set_background(w->pgplot.pgx, &w->pgplot.bg); pgx_set_foreground(w->pgplot.pgx, &w->pgplot.fg); /* * Allow for margins. */ pgx_set_margin(w->pgplot.pgx, w->pgplot.pad_x, w->pgplot.pad_y); /* * Reset its scroll-bars. */ xmp_update_scroll_bars(w); return w; } /*....................................................................... * Find an active PGPLOT widget of a given name, close it to PGPLOT and * move it to the head of the inactive list of widgets. * * Input: * name char * The name of the widget. * Output: * return XmPgplotWidget The selected widget, or NULL if not found. */ static XmPgplotWidget xmp_close_widget(char *name) { XmPgplotWidget w; /* * Remove the widget from the active list. */ w = xmp_RemoveWidget(name, XMP_ACTIVE_WIDGETS); if(!w) { fprintf(stderr, "%s: Request to close non-existent widget (%s).\n", XMP_IDENT, name ? name : "(null)"); return NULL; }; /* * Remove cursor handler. */ xmp_DisarmCursor(w); /* * Close the connection to the PgxWin library. */ pgx_close(w->pgplot.pgx); /* * Invalidate the pgslct() id. The next time that the widget is opened * to PGPLOT a different value will likely be used. */ w->pgplot.pgslct_id = 0; /* * Prepend the widget to the free list. */ xmp_PrependWidget(w, XMP_FREE_WIDGETS); return w; } /*....................................................................... * Lookup a widget by name from a given list of widgets. * * Input: * name char * The name of the widget. * type int The enumerated name of the list to search, * from: * XMP_ACTIVE_WIDGETS * XMP_FREE_WIDGETS * Output: * prev XmPgplotWidget * *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return XmPgplotWidget The located widget, or NULL if not found. */ static XmPgplotWidget xmp_FindWidgetByName(char *name, int type, XmPgplotWidget *prev) { XmPgplotList *widget_list; /* The list to be searched */ widget_list = xmp_WidgetList(type); if(widget_list && name) { XmPgplotWidget last = NULL; XmPgplotWidget node = widget_list->head; for( ; node; last = node, node = node->pgplot.next) { if(strcmp(node->pgplot.pgx->name, name)==0) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup a widget by its PGPLOT id from a given list of widgets. * * Input: * xmslct_id int The number used by PGPLOT to select the * device. * type int The enumerated name of the list to search, * from: * XMP_ACTIVE_WIDGETS * XMP_FREE_WIDGETS * Output: * prev XmPgplotWidget * *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return XmPgplotWidget The located widget, or NULL if not found. */ static XmPgplotWidget xmp_FindWidgetByID(int xmslct_id, int type, XmPgplotWidget *prev) { XmPgplotList *widget_list; /* The list to be searched */ widget_list = xmp_WidgetList(type); if(widget_list) { XmPgplotWidget last = NULL; XmPgplotWidget node = widget_list->head; for( ; node; last = node, node = node->pgplot.next) { if(xmslct_id == node->pgplot.xmslct_id) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup one of the PGPLOT class widget lists by its enumerated type. * * Input: * type int The enumerated name of the list, from: * XMP_ACTIVE_WIDGETS * XMP_FREE_WIDGETS * Output: * return XmPgplotList * The widget list, or NULL if not recognized. */ static XmPgplotList *xmp_WidgetList(int type) { switch(type) { case XMP_ACTIVE_WIDGETS: return &xmPgplotClassRec.pgplot_class.active_widgets; case XMP_FREE_WIDGETS: return &xmPgplotClassRec.pgplot_class.free_widgets; default: fprintf(stderr, "xmp_WidgetList: No such list.\n"); }; return NULL; } /*....................................................................... * Remove a given widget from one of the PGPLOT class widget lists. * * Input: * name char * The name of the widget to be removed from * the list. * type int The enumerated name of the list from which to * remove the widget, from: * XMP_ACTIVE_WIDGETS * XMP_FREE_WIDGETS * Output: * return XmPgplotWidget The removed widget, or NULL if not found. */ static XmPgplotWidget xmp_RemoveWidget(char *name, int type) { XmPgplotList *widget_list; /* The list to remove the widget from */ XmPgplotWidget w = NULL; /* The widget being removed */ XmPgplotWidget prev; /* The widget preceding w in the list */ /* * Get the widget list. */ widget_list = xmp_WidgetList(type); if(widget_list) { w = xmp_FindWidgetByName(name, type, &prev); if(w) { if(prev) { prev->pgplot.next = w->pgplot.next; } else { widget_list->head = w->pgplot.next; }; w->pgplot.next = NULL; }; }; return w; } /*....................................................................... * Prepend a PGPLOT widget to a given PGPLOT class widget list. * * Input: * w XmPgplotWidget The widget to add to the list. * type int The enumerated name of the list to add to, * from: * XMP_ACTIVE_WIDGETS * XMP_FREE_WIDGETS * Output: * return XmPgplotWidget The added widget (the same as w), or NULL * on error. */ static XmPgplotWidget xmp_PrependWidget(XmPgplotWidget w, int type) { XmPgplotList *widget_list; /* The list to prepend the widget to */ /* * Get the widget list. */ widget_list = xmp_WidgetList(type); if(widget_list) { w->pgplot.next = widget_list->head; widget_list->head = w; }; return w; } /*....................................................................... * Return the currently selected PGPLOT device. * * Input: * context char * If no XmPgplot device is currently selected * and context!=NULL then, an error message of * the form printf("%s: ...\n", context) will * be written to stderr reporting that no * device is open. * Output: * return XmPgplotWidget The currently selected PGPLOT device, or * NULL if no device is currently selected. */ static XmPgplotWidget xmp_CurrentWidget(char *context) { XmPgplotWidget w = xmPgplotClassRec.pgplot_class.active_widgets.head; if(w) { /* * We need a window. */ if(!XtIsRealized((Widget)w)) { if(context) { fprintf(stderr, "%s: PGPLOT widget \"%s\" is not realized.\n", context, w->pgplot.pgx->name); }; w = NULL; }; } else { if(context) fprintf(stderr, "%s: No /xm device is currently selected.\n", context); }; return w; } /*....................................................................... * This is the only external entry point to the /xm device driver. * It is called by PGPLOT to open, perform operations on, return * information about and close /xmotif windows. * * Input: * ifunc int * The PGPLOT operation code to be executed. * Input/output: * rbuf float * A general buffer for input/output of float values. * nbuf int * Where relevant this is used to return the number of * elements in rbuf[]. Also used on input to specify * number of pixels in the line-of-pixels primitive. * chr char * A general buffer for string I/O. * lchr int * Where relevant this is used to send and return the * number of significant characters in chr. * Input: * len int Added to the call line by the FORTRAN compiler. * This contains the declared size of chr[]. */ #ifdef VMS void xmdriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void XMDRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif /* * Get the active widget if there is one. */ XmPgplotWidget w = xmp_CurrentWidget(NULL); XmPgplotPart *xmp = w ? &w->pgplot : NULL; PgxWin *pgx = xmp ? xmp->pgx : NULL; int i; /* * Flush buffered opcodes. */ pgx_pre_opcode(pgx, *ifunc); /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { char *dev_name = "XMOTIF (X window widget_name/xm)"; strncpy(chr, dev_name, len); *lchr = strlen(dev_name); for(i = *lchr; i < len; i++) chr[i] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = -1.0; /* Report no effective max plot width */ rbuf[2] = 0.0; rbuf[3] = -1.0; /* Report no effective max plot height */ rbuf[4] = 0.0; rbuf[5] = (pgx && !pgx->bad_device) ? pgx->color->ncol-1 : 1; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: pgx_get_resolution(pgx, &rbuf[0], &rbuf[1]); rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'I'; /* Interactive device */ chr[1] = 'X'; /* Cursor is available and opcode 27 is desired */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines */ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ chr[7] = 'N'; /* Don't prompt on pgend */ chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10]= 'S'; /* Area-scroll available */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: chr[0] = '\0'; /* Default name is "" */ *lchr = 0; break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: pgx_def_size(pgx, XMP_DEF_WIDTH, XMP_DEF_HEIGHT, rbuf, nbuf); break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: { XmPgplotWidget new_w = xmp_FindWidgetByID((int)(rbuf[1]+0.5), XMP_ACTIVE_WIDGETS, NULL); if(new_w) { new_w->pgplot.pgslct_id = (int) (rbuf[0]+0.5); xmp_RemoveWidget(new_w->pgplot.pgx->name, XMP_ACTIVE_WIDGETS); xmp_PrependWidget(new_w, XMP_ACTIVE_WIDGETS); } else { fprintf(stderr, "%s: [Select plot] No such open device.\n", XMP_IDENT); }; }; break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: /* * Assign the returned device unit number and success indicator. * Assume failure to open until the workstation is open. */ rbuf[0] = rbuf[1] = 0.0; *nbuf = 2; /* * Prepare the display name. */ if(*lchr >= len) { fprintf(stderr, "%s: Widget name too long.\n", XMP_IDENT); return; } else { chr[*lchr] = '\0'; }; /* * Get the requested widget from the free widget list. */ w = xmp_open_widget(chr); if(!w) return; rbuf[0] = w->pgplot.xmslct_id; /* The number used to select this device */ rbuf[1] = 1.0; *nbuf = 2; break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: /* * Remove the device from the list of open devices. */ if(pgx) xmp_close_widget(pgx->name); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: pgx_begin_picture(pgx, rbuf); break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: pgx_draw_line(pgx, rbuf); break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: pgx_draw_dot(pgx, rbuf); break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: pgx_set_ci(pgx, (int) (rbuf[0] + 0.5)); break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: pgx_flush(pgx); break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: if(w) { xmp_DisarmCursor(w); if(!XtIsManaged((Widget)w)) XtManageChild((Widget)w); }; pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr); break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ /* (Not implemented: no alpha screen) */ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ /* (Not implemented: should not be called) */ case 19: break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: pgx_poly_fill(pgx, rbuf); break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: pgx_set_rgb(pgx, (int)(rbuf[0]+0.5), rbuf[1],rbuf[2],rbuf[3]); break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: pgx_set_lw(pgx, rbuf[0]); break; /*--- IFUNC=23, Escape --------------------------------------------------*/ /* (Not implemented: ignored) */ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: pgx_rect_fill(pgx, rbuf); break; /*--- IFUNC=25, ---------------------------------------------------------*/ /* (Not implemented: ignored) */ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: pgx_pix_line(pgx, rbuf, nbuf); break; /*--- IFUNC=27, World-coordinate scaling --------------------------------*/ case 27: pgx_set_world(pgx, rbuf); break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: pgx_get_rgb(pgx, rbuf, nbuf); break; /*--- IFUNC=30, Scroll rectangle ----------------------------------------*/ case 30: pgx_scroll_rect(pgx, rbuf); break; /*--- IFUNC=?, ----------------------------------------------------------*/ default: fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n", XMP_IDENT, *ifunc); *nbuf = -1; break; }; return; } /*....................................................................... * This function is called upon by the pgxwin toolkit whenever the * pixmap used as backing store needs to be resized. * * Input: * pgx PgxWin * The pgxwin toolkit context descriptor. * width unsigned The desired new pixmap width. * height unsigned The desired new pixmap height. */ static void xmp_NewPixmap(PgxWin *pgx, unsigned width, unsigned height) { XmPgplotWidget w = (XmPgplotWidget) pgx->context; /* * Record the requested dimensions then hand the job of allocating the * pixmap back to the pgxwin toolkit. */ w->pgplot.scroll.width = width; w->pgplot.scroll.height = height; w->pgplot.scroll.x = 0; w->pgplot.scroll.y = 0; xmp_update_scroll_bars(w); pgx_new_pixmap(pgx, width, height); return; } /*....................................................................... * Whenever the size of a pixmap and/or window of a PGPLOT winget are * changed, this function should be called to adjust scroll bars if the * parent is a scrolled window widget. * * Input: * w XmPgplotWidget The pgplot widget instance. */ static void xmp_update_scroll_bars(XmPgplotWidget w) { if(w->pgplot.scroll.is_scrolled) { XmPgplotPart *xmp = &w->pgplot; XmpScroll *scroll = &xmp->scroll; /* * Ensure that the scroll area has a finite size. */ if(scroll->width < 1) scroll->width = 1; if(scroll->height < 1) scroll->height = 1; /* * Update the horizontal scroll-bar. */ XtVaSetValues(xmp->scroll.w_hbar, XmNsliderSize, w->core.width, XmNpageIncrement, w->core.width, XmNmaximum, scroll->width > w->core.width ? scroll->width : w->core.width, XmNvalue, scroll->x / scroll->width, NULL); /* * Update the vertical scroll-bar. */ XtVaSetValues(xmp->scroll.w_vbar, XmNsliderSize, w->core.height, XmNpageIncrement, w->core.height, XmNmaximum, scroll->height > w->core.height ? scroll->height : w->core.height, XmNvalue, scroll->y / scroll->height, NULL); /* * Tell pgplot about the current scroll and pan values. */ pgx_scroll(xmp->pgx, scroll->x, scroll->y); }; return; } /*....................................................................... * This function is called whenever a scrollbar of a parent scrolled * window widget is moved. */ static void xmp_scroll_callback(Widget widget, XtPointer client_data, XtPointer call_data) { XmScrollBarCallbackStruct *bar = (XmScrollBarCallbackStruct *) call_data; XmPgplotWidget w = (XmPgplotWidget) client_data; XmPgplotPart *xmp = &w->pgplot; XmpScroll *scroll = &xmp->scroll; /* * Determine which scroll-bar was responsible for this call. */ if(widget == scroll->w_hbar) { scroll->x = bar->value; } else if(widget == scroll->w_vbar) { scroll->y = bar->value; }; /* * Scroll the pixmap. */ pgx_scroll(xmp->pgx, xmp->scroll.x, xmp->scroll.y); return; } /*....................................................................... * This function provides an asynchronous alternative to pgband() and * pgcurs(). It creates an event handler which ensures that the X cursor * is augmented with selected rubber-band graphics when visible, and * which calls a specified user cursor-input callback when the user * presses a key or button over the window. As with pgband() all * specified and reported coordinates are world coordinates. The * cursor is automatically disarmed in xmdriv() if the pgband() opcode * is invoked. It is also disarmed when the pgplot close-workstation * opcode is invoked. * * Input: * widget Widget The PGPLOT widget to connect a cursor to. * mode int The type of cursor augmentation (see XmPgplot.h). * xref,yref float The world-coordinate reference point for band-type * cursors. * callback XtCallbackProc The callback function to call when input events * are received. * client_data void * Client-specific data to be sent to the callback * function. * Output: * return int 0 - OK. * 1 - Error. */ int xmp_arm_cursor(Widget widget, int mode, float xref, float yref, XtCallbackProc callback, void *client_data) { XmPgplotWidget w = (XmPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xmp_arm_cursor: NULL widget.\n"); return 1; }; /* * Make sure that the widget is currently open to PGPLOT. */ if(w->pgplot.pgslct_id == 0) { fprintf(stderr, "xmp_arm_cursor: The widget is not open to PGPLOT.\n"); return 1; }; /* * Delegate the work to an internal function. */ return xmp_ArmCursor(w, mode, xref, yref, callback, client_data); } /*....................................................................... * Erase the cursor, remove input callbacks and remove the cursor * event handler. * * Input: * widget Widget The PGPLOT widget to disconnect the cursor from. * Output: * return int 0 - OK. * 1 - Error. */ int xmp_disarm_cursor(Widget widget) { if(!widget) { fprintf(stderr, "xmp_disarm_cursor: NULL widget intercepted.\n"); return 1; }; return xmp_DisarmCursor((XmPgplotWidget)widget); } /*....................................................................... * This is the cursor event handler registered by xmp_arm_cursor(). */ static void xmp_CursorHandler(Widget widget, XtPointer client_data, XEvent *event, Boolean *cont) { XmPgplotWidget w = (XmPgplotWidget) widget; XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; float rbuf[2]; char key; /* * Perform input-focus management? */ if(XmIsTraversable(widget)) { /* * Allow Motif Tab-group traversal by ignoring all Tab-key groups. */ if(event->type == KeyPress && XLookupKeysym(&event->xkey, 0) == XK_Tab) return; /* * If the event that we are responding to is a button press and * the widget doesn't currently have keyboard input focus, turn * keyboard focus on and discard the button press. */ if(event->type == ButtonPress && !w->primitive.have_traversal && _XmGetFocusPolicy(widget) == XmEXPLICIT) { XmProcessTraversal(widget, XmTRAVERSE_CURRENT); return; }; }; /* * Handle the event. */ if(pgx_cursor_event(pgx, event, rbuf, &key) && xmp->input.callback) { XmpCursorCallbackStruct call_data; pgx_dev2world(pgx, rbuf); call_data.x = rbuf[0]; call_data.y = rbuf[1]; call_data.key = key; (*xmp->input.callback)(widget, (XtPointer) xmp->input.client_data, (XtPointer) &call_data); }; /* * Handle errors. */ if(pgx->bad_device) { *cont = False; xmp_DisarmCursor(w); } else { *cont = True; }; return; } /*....................................................................... * The private work-horse function of xmp_arm_cursor(). Note that * this function takes an XmPgplotWidget argument whereas xmp_arm_cursor() * takes a generic Widget argument. * * Input: * w XmPgplotWidget The PGPLOT widget to connect a cursor to. * mode int The type of cursor augmentation (see XmPgplot.h). * xref,yref float The world-coordinate reference point for band-type * cursors. * callback XtCallbackProc The callback function to call when input events * are received, or 0 if keyboard and button * events are to be handled externally. * client_data void * Client-specific data to be sent to the callback * function. * Output: * return int 0 - OK. * 1 - Error. */ static int xmp_ArmCursor(XmPgplotWidget w, int mode, float xref, float yref, XtCallbackProc callback, void *client_data) { Widget widget = (Widget) w; XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; float rbuf[2]; /* * Remove any existing cursor. */ xmp_DisarmCursor(w); /* * Convert xref, yref from world coordinates to device coordinates. */ rbuf[0] = xref; rbuf[1] = yref; pgx_world2dev(pgx, rbuf); /* * Raise the cursor. */ if(pgx_set_cursor(pgx, -1, mode, 0, rbuf, rbuf)) return 1; /* * If the pointer is currently in the window, record its position * and draw the cursor. */ if(pgx_locate_cursor(pgx)) pgx_draw_cursor(pgx); /* * Assemble the cursor-hander event-mask. */ xmp->input.mask = EnterWindowMask | LeaveWindowMask | PointerMotionMask; /* * Only select for keyboard and button input if a callback was * provided. */ if(callback) xmp->input.mask |= KeyPressMask | ButtonPressMask; /* * Record the callback and its data. */ xmp->input.callback = callback; xmp->input.client_data = client_data; /* * Register an event handler to handle asychronous cursor input. */ XtAddEventHandler(widget, xmp->input.mask, False, xmp_CursorHandler, (XtPointer) 0); /* * Make sure that the widget is visible. */ if(!XtIsManaged(widget)) XtManageChild(widget); return 0; } /*....................................................................... * The private work-horse function of xmp_disarm_cursor(). Note that * this function takes an XmPgplotWidget argument whereas * xmp_disarm_cursor() takes a generic Widget argument. * * w XmPgplotWidget The widget to disconnect the cursor from. * Output: * return int 0 - OK. * 1 - Error. */ static int xmp_DisarmCursor(XmPgplotWidget w) { if(w) { XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; /* * Do nothing if the cursor is inactive. */ if(xmp->input.mask == NoEventMask) return 0; /* * Remove the current event handler. */ XtRemoveEventHandler((Widget) w, xmp->input.mask, False, xmp_CursorHandler, (XtPointer) 0); /* * Remove the callback function and its data. */ xmp->input.callback = 0; xmp->input.client_data = NULL; /* * Erase the cursor. */ if(pgx_erase_cursor(pgx) || pgx_set_cursor(pgx, 0, PGX_NORM_CURSOR, 0, NULL, NULL)) return 1; }; return 0; } /*....................................................................... * Get the visual and colormap for a new window as specified by X * resource values. * * Input: * w XmPgplotWidget The PGPLOT widget. * Output: * return int 0 - OK. * 1 - Error. */ static int xmp_new_visual(XmPgplotWidget w) { XmPgplotPart *xmp = &w->pgplot; PgxWin *pgx = xmp->pgx; /* * Allocate colors from parent visual and colormap? */ if(xmp->visual == CopyFromParent || w->core.colormap == CopyFromParent) { /* * Find the first parent widget that has a window. */ Widget parent = (Widget) w; do { parent = XtParent(parent); } while(parent && XtWindow(parent)==None); if(!parent) { fprintf(stderr, "xmp_new_visual: No parent window found.\n"); return 1; }; /* * Locate the visual and colormap of the parent and allocate colors from them. */ if(!pgx_window_visual(pgx, XtWindow(parent), xmp->min_colors, xmp->max_colors, xmp->share)) return 1; } /* * Allocate colors from a specified colormap and visual. */ else { if(!pgx_adopt_visual(pgx, XVisualIDFromVisual(xmp->visual), w->core.colormap, xmp->min_colors, xmp->max_colors, xmp->share)) return 1; }; /* * Record what kind of colors were actually allocated. */ xmp->share = xmp->pgx->color->readonly; return 0; } /*....................................................................... * Return an unambiguous PGPLOT device-specification that can be used * as the FILE argument of cpgbeg() to open a given PGPLOT widget. * * Input: * widget Widget The PGPLOT widget to return a device string for. * Output: * return char * The PGPLOT device-specication. Note that the returned * string is owned by the widget driver and must not be * free()d or overwritten. */ char *xmp_device_name(Widget widget) { if(!widget || XtClass(widget) != xmPgplotWidgetClass) { fprintf(stderr, "xmp_device_name: Not a Motif PGPLOT widget.\n"); return "/null"; }; return ((XmPgplotWidget) widget)->pgplot.device; } /*....................................................................... * Return the pgslct_id of the given widget. This can then be used with * the cpgslct() function to select the widget as the currently * active widget. * * Input: * widget Widget The PGPLOT widget to return a device string for. * Output: * return int The PGPLOT device-id. This will be 0 if the widget * is not currently open to PGPLOT. */ int xmp_device_id(Widget widget) { if(!widget || XtClass(widget) != xmPgplotWidgetClass) { fprintf(stderr, "xmp_device_id: Not a Motif PGPLOT widget.\n"); return 0; } else { XmPgplotWidget w = (XmPgplotWidget) widget; if(w->pgplot.pgslct_id <= 0) { fprintf(stderr, "xmp_device_id: The specified widget is not currently open to PGPLOT.\n"); }; return w->pgplot.pgslct_id; }; } /*....................................................................... * The following is a convenience none-variadic function for creating * a PGPLOT widget. Note that XtManageChild() should be applied to the * returned widget. * * Input: * parent Widget The parent widget to adopt. * name char * The name to give the widget. * arglist ArgList A list of X resources. * argcount Cardinal The number of X resources. * Output: * return Widget The new PGPLOT widget. */ Widget XmCreatePgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount) { return XtCreateWidget(name, xmPgplotWidgetClass, parent, arglist, argcount); } /*....................................................................... * The following is a convenience none-variadic function for creating * a PGPLOT widget with scroll-bars. Note that XtManageChild() should * be applied to the returned widget if you want the PGPLOT window to * fit exactly within the ScrollBar widget area. * * Input: * parent Widget The parent widget to adopt. * name char * The name to give the widget. * arglist ArgList A list of X resources. * argcount Cardinal The number of X resources. * Output: * return Widget The new PGPLOT widget. */ Widget XmCreateScrolledPgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount) { char *scroll_name; /* The name to give the scroll-bar widget */ ArgList scroll_args; /* The scroll-bar resource argument list */ Cardinal scroll_count; /* The number of defined entries in scroll_args */ Widget scroll_w; /* The ScrollBar widget */ Widget pgplot_w; /* The PGPLOT widget */ int i; /* * We need to create a name for the scrolled window. Follow the * convention used by the Motif Text Widget of appending "SW" to the * existing name. */ scroll_name = (char *) XtMalloc(sizeof(char) * strlen(name) + 3); sprintf(scroll_name, "%sSW", name); /* * We need to construct a resource assignment list for the * ScrollBar widget. This is done by copying the input argument list * and appending some standard ScrollBar resources. */ scroll_args = (ArgList) XtMalloc(sizeof(Arg) * (argcount + 4)); /* * Copy the input argument list. */ scroll_count = 0; for(i=0; ipgplot.pgx, 1, w->core.width, w->core.height, w->primitive.highlight_thickness); } /*....................................................................... * This function is a XtResourceDefaultProc function used to return * the default highlight color. It is used to initialize the * XmNhighlightColor resource. */ static void xmp_GetDefaultHighlightColor(Widget widget, int offset, XrmValue *value) { static Pixel pixel; pixel = WhitePixel(XtDisplay(widget),XScreenNumberOfScreen(XtScreen(widget))); value->addr = (XtPointer) &pixel; } /*....................................................................... * This function is a XtResourceDefaultProc function used to return * the default background color. It is used to initialize the * XmNbackground resource. */ static void xmp_GetDefaultBackgroundColor(Widget widget, int offset, XrmValue *value) { static Pixel pixel; pixel = BlackPixel(XtDisplay(widget),XScreenNumberOfScreen(XtScreen(widget))); value->addr = (XtPointer) &pixel; } /*....................................................................... * This function is a XtResourceDefaultProc function used to return * the default foreground color. It is used to initialize the * XmNforeground resource. */ static void xmp_GetDefaultForegroundColor(Widget widget, int offset, XrmValue *value) { static Pixel pixel; pixel = WhitePixel(XtDisplay(widget),XScreenNumberOfScreen(XtScreen(widget))); value->addr = (XtPointer) &pixel; } /*....................................................................... * This is an application-level utility function for converting from * PGPLOT world coordinates to X-window pixel coordinates. * * Input: * widget Widget The PGPLOT widget whose coordinates are to be * converted. * wx, wy float The PGPLOT world coordinates to be converted. * Output: * px, py int * On output, *px and *py will be assigned with the * X-window pixel coordinates that correspond to wx,wy. * return int 0 - OK. * 1 - Error. */ int xmp_world_to_pixel(Widget widget, float wx, float wy, int *px, int *py) { XmPgplotWidget w = (XmPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xmp_world_to_pixel: NULL widget.\n"); return 1; }; /* * Delegate the conversion to an internal function. */ return xmp_WorldToPixel(w, wx, wy, px, py); } /*....................................................................... * This is an application-level utility function for converting from * X-window pixel coordinates to PGPLOT world coordinates. * * Input: * widget Widget The PGPLOT widget whose coordinates are to be * converted. * px, py int * The X-window pixel coordinates to be converted. * Output: * wx, wy float * On output, *wx and *wy will be assigned with the * PGPLOT world coordinates that correspond to px,py. * return int 0 - OK. * 1 - Error. */ int xmp_pixel_to_world(Widget widget, int px, int py, float *wx, float *wy) { XmPgplotWidget w = (XmPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xmp_pixel_to_world: NULL widget.\n"); return 1; }; /* * Delegate the conversion to an internal function. */ return xmp_PixelToWorld(w, px, py, wx, wy); } /*....................................................................... * This is an internal function for converting from X-window pixel * coordinates to PGPLOT world coordinates. * * Input: * w XmPgplotWidget The widget whose coordinates are to be converted. * px, py int * The X-window pixel coordinates to be converted. * Output: * wx, wy float * On output, *wx and *wy will be assigned with the * PGPLOT world coordinates that correspond to px,py. * return int 0 - OK. * 1 - Error. */ static int xmp_PixelToWorld(XmPgplotWidget w, int px, int py, float *wx, float *wy) { PgxWin *pgx = w->pgplot.pgx; float rbuf[2]; /* * Convert the specified pixel coordinates to world coordinates. */ pgx_win2dev(pgx, px, py, rbuf); pgx_dev2world(pgx, rbuf); /* * Assign the return values if possible. */ if(wx) *wx = rbuf[0]; if(wy) *wy = rbuf[1]; return 0; } /*....................................................................... * This is an internal function for converting from PGPLOT world * coordinates to X-window pixel coordinates. * * Input: * w XmPgplotWidget The widget whose coordinates are to be converted. * wx, wy float The PGPLOT world coordinates to be converted. * Output: * px, py int * On output, *px and *py will be assigned with the * X-window pixel coordinates that correspond to wx,wy. * return int 0 - OK. * 1 - Error. */ static int xmp_WorldToPixel(XmPgplotWidget w, float wx, float wy, int *px, int *py) { PgxWin *pgx = w->pgplot.pgx; float rbuf[2]; /* * Convert the world coordinate to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; pgx_world2dev(pgx, rbuf); pgx_dev2win(pgx, rbuf, px, py); return 0; } he widget as the currently * active widget. * * Input: * widget Widget The PGPLOT widget to return a device string for. * Output: * return int The PGPLOT device-id. This will be 0 if the widget * is not currently open to PGPLOT. */ int xmp_device_id(Widget widget) { if(!widget || XtClass(widget) != xmPgplotWidgetClass) { fprintf(stderr, "xmp_device_id: Not a Motif PGPLOT widget.\n"); return 0; } else { XmPgplotWidgpgplot/drivers/xmotif/XmPgplot.h010064400040640000322000000072520650067713200174550ustar00tjpcitmbr00000400000017#ifndef XmPgplot_h #define XmPgplot_h #ifdef __cplusplus extern "C" { #endif /* * Define resource-name constants. */ #define XmpNminColors "minColors" #define XmpCMinColors "MinColors" #define XmpNmaxColors "maxColors" #define XmpCMaxColors "MaxColors" #define XmpNpadX "padX" #define XmpCPadX "PadX" #define XmpNpadY "padY" #define XmpCPadY "PadY" #define XmpNshare "share" #define XmpCShare "Share" #define XMP_NORM_CURSOR 0 /* Un-augmented X cursor */ #define XMP_LINE_CURSOR 1 /* Line cursor between ref and pointer */ #define XMP_RECT_CURSOR 2 /* Rectangular cursor between ref and pointer */ #define XMP_YRNG_CURSOR 3 /* Two horizontal lines, at ref.x and pointer.x */ #define XMP_XRNG_CURSOR 4 /* Two vertical lines, at ref.y and pointer.y */ #define XMP_HLINE_CURSOR 6 /* Horizontal line cursor at y=ref.y */ #define XMP_VLINE_CURSOR 5 /* Vertical line cursor at x=ref.x */ #define XMP_CROSS_CURSOR 7 /* Cross-hair cursor centered on the pointer */ /* * When a cursor-input callback [previously registered using xmp_arm_cursor()] * is called by the widget, the position of the cursor and the key * that the user pressed are recorded in a struct of the following * form. A pointer to this struct is then cast to (XtPointer) and * passed as the 'call_data' argument of the callback function. The * callback function should cast this argument back to * (XmpCursorCallbackStruct *) in order to access its fields. */ typedef struct { float x,y; /* The world-coordinate position of the cursor */ char key; /* The key pressed by the user (Mouse buttons='A','D','X') */ } XmpCursorCallbackStruct; int xmp_arm_cursor(Widget widget, int mode, float xref, float yref, XtCallbackProc callback, void *client_data); int xmp_disarm_cursor(Widget widget); /* * Record the official PGPLOT device name of the widget driver. */ #define XMP_DEVICE "XMOTIF" /* * The following function returns an unambiguous PGPLOT device-specification * that can be used as the FILE argument of cpgbeg() to open a given PGPLOT * widget. It simply returns a string composed of the widget name, followed * by a "/" followed by XMP_DEVICE. Note that the returned string is owned * by the widget and must not be free()d or overwritten. */ char *xmp_device_name(Widget widget); /* * After a widget has been opened to PGPLOT (via pgopen or pgbeg), the * following function can be used to return the PGPLOT id of the device. * When multiple PGPLOT devices are open this id can then be used with * the PGPLOT cpgslct() function to select the widget as the currently * selected PGPLOT graphics device. * * If the specified widget has not been opened to pgplot, or has been * closed and not re-opened, then 0 will be returned. */ int xmp_device_id(Widget widget); /* * The following global is a pointer to the shared class context * descriptor and is what is passed to XtCreateManagedWidget() * to tell it what type of widget to create. */ externalref WidgetClass xmPgplotWidgetClass; /* * Declare opaque aliases to the widget class and instance structures. */ typedef struct XmPgplotClassRec *XmPgplotWidgetClass; typedef struct XmPgplotRec *XmPgplotWidget; /* * Convenience widget creation functions. */ Widget XmCreatePgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount); Widget XmCreateScrolledPgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount); /* * The following functions allow conversions between PGPLOT world coordinates * and X-window pixel coordinates. */ int xmp_pixel_to_world(Widget widget, int px, int py, float *wx, float *wy); int xmp_world_to_pixel(Widget widget, float wx, float wy, int *px, int *py); #ifdef __cplusplus } #endif #endif pgplot/drivers/xmotif/XmPgplotP.h010064400040640000322000000101770650067766500176100ustar00tjpcitmbr00000400000017#ifndef XmPgplotP_h #define XmPgplotP_h #if XmVersion == 1001 #include #else #include #endif #include "XmPgplot.h" #include "pgxwin.h" /* * Declare a container for a list of widgets. */ typedef struct { XmPgplotWidget head; /* The head of the list of widgets */ } XmPgplotList; /* * Declare the structure that will contain class-specific * attributes. These are effectively shared by all instances * of the class widgets. */ typedef struct XmPgplotClassPart { int widget_id_counter; /* Used to give widgets unique numeric identifiers */ XmPgplotList active_widgets; /* List of active widgets */ XmPgplotList free_widgets; /* List of unnassigned widgets */ XtPointer *extension; /* Unused extension field */ } XmPgplotClassPart; /* * Collect all class-specific parts from superclasses and the current * new class. */ typedef struct XmPgplotClassRec { CoreClassPart core_class; XmPrimitiveClassPart primitive_class; XmPgplotClassPart pgplot_class; } XmPgplotClassRec; externalref XmPgplotClassRec xmPgplotClassRec; /* * A context descriptor for managing parent ScrolledWindow scroll-bars. */ typedef struct { int is_scrolled; /* True if the parent is a scrolled window */ Widget w_hbar; /* Widget id of horizontal scroll-bar */ Widget w_vbar; /* Widget id of vertical scroll-bar */ unsigned width; /* The width of the pixmap being scrolled */ unsigned height; /* The height of the pixmap being scrolled */ unsigned x; /* Pixmap X coordinate of top left corner of window */ unsigned y; /* Pixmap Y coordinate of top left corner of window */ } XmpScroll; /* * A context descriptor for dispatching pointer input events. */ typedef struct { unsigned long mask; /* The current cursor event-mask */ XtCallbackProc callback; /* The cursor-event client callback, or 0 */ void *client_data; /* Client data to be sent to the callback */ } XmpInput; /* * Now declare a structure to contain the instance specific parts of * the class. This contains members that are different from one * instance of the widget class to the next. */ typedef struct XmPgplotPart { /* Public resource attributes */ int max_colors; /* The max number of colors needed */ int min_colors; /* The min number of colors needed */ Colormap colormap; /* The default colormap to use */ Visual *visual; /* The default visual to use */ XtCallbackList resize_callback; /* User resize-window callbacks */ Dimension pad_x; /* The number of pixels to assign to the optional */ /* margin either side of the viewsurface */ Dimension pad_y; /* The number of pixels to assign to the optional */ /* margin above and below the viewsurface */ Boolean share; /* Non-zero to allocate shared color cells */ /* Private attributes */ XmPgplotWidget next; /* The next widget of a list of PGPLOT Motif widgets */ int xmslct_id; /* The device ID returned to PGPLOT by the */ /* open-workstation driver opcode, and used for */ /* subsequent device selection via the */ /* select-plot driver opcode */ int pgslct_id; /* The device ID returned to the application by */ /* pgopen() for subsequent device selection with */ /* the pgslct() function */ char *device; /* A possible PGPLOT cpgbeg() file string */ XtAppContext app; /* The application context */ XmpScroll scroll; /* Used to maintain parent ScrolledWindow scroll bars */ XmpInput input; /* Cursor input callback and client data container */ XColor bg, fg; /* The RGB values of the current foreground and */ /* background colors. The pixel member is ignored. */ PgxWin *pgx; /* PGPLOT generic X-window context descriptor */ } XmPgplotPart; /* * Collect the instance structures of the super-classes and the * PGPLOT class. */ typedef struct XmPgplotRec { CorePart core; XmPrimitivePart primitive; XmPgplotPart pgplot; } XmPgplotRec; #endif pgplot/drivers/xmotif/pgmdemo.c010064400040640000322000001212750650071565000173260ustar00tjpcitmbr00000400000017#include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "XmPgplot.h" #include "cpgplot.h" /* Make the demo backwardly compatible with Motif 1.1 */ #if XmVersion <= 1001 #ifndef XmFONTLIST_DEFAULT_TAG #define XmFONTLIST_DEFAULT_TAG XmSTRING_DEFAULT_CHARSET #endif #endif /* * Make the demo backwardly compatible with older versions of X. */ #if XtSpecificationRelease <= 4 #define XtSetLanguageProc(a,b,c) (void)((a),(b),(c)) #endif /* * Gray-scale images of multiple analytic 2D functions will be supported. * Each 2D function will be encapsulated in a C function of the * following type. */ #define IMAGE_FN(fn) float (fn)(float x, float y) /* * Define a macro for prototyping and defining XtCallbackProc functions. */ #define CALL_FN(fn) void (fn)(Widget w, XtPointer client_data, XtPointer call_data) /* * List the prototypes of the available 2D-function functions. */ static IMAGE_FN(sinc_fn); static CALL_FN(sinc_callback); static IMAGE_FN(gaus_fn); static CALL_FN(gaus_callback); static IMAGE_FN(ring_fn); static CALL_FN(ring_callback); static IMAGE_FN(sin_angle_fn); static CALL_FN(sin_angle_callback); static IMAGE_FN(cos_radius_fn); static CALL_FN(cos_radius_callback); static IMAGE_FN(star_fn); static CALL_FN(star_callback); /* Color table menu callbacks */ static CALL_FN(grey_callback); static CALL_FN(rainbow_callback); static CALL_FN(heat_callback); static CALL_FN(aips_callback); /* Set the default image size */ enum {MAP_SIZE=129}; /* Set the number of points plotted per slice */ enum {SLICE_SIZE=100}; /* * Declare a type to hold a single X,Y coordinate. */ typedef struct { float x, y; /* World coordinates */ } Vertex; /* * Declare the object type that will contain the context of the * image and slice plots. */ typedef struct { Widget w_coord; /* Coordinate-display label widget */ Widget w_image; /* The gray-scale image widget */ Widget w_slice; /* The slice-plot image widget */ float *image; /* The gray-scale image array */ float *slice; /* The slice compilation array */ float scale; /* Coversion factor pixels -> coords */ int image_size; /* The number of pixels along each side of the image */ int slice_size; /* The length of the slice array */ int xa,xb; /* Min and max X pixel coordinates */ int ya,yb; /* Min and max Y pixel coordinates */ float datamin; /* The minimum data value in image[] */ float datamax; /* The maximum data value in image[] */ IMAGE_FN(*fn); /* The function to be displayed */ Vertex va; /* The start of the latest slice line */ Vertex vb; /* The end of the latest slice line */ Widget w_top; /* The top-level widget of the application */ Cursor busy; /* The cursor to display when un-responsive */ } Image; /* * Image object contructor and destructor functions. */ static Image *new_Image(unsigned image_size, unsigned slice_size, IMAGE_FN(*fn), Widget parent, Widget w_top); static Image *del_Image(Image *im); /* * Image and slice display functions. */ static void display_fn(Image *im, IMAGE_FN(*fn)); static void display_image(Image *im, int id); static void display_slice(Image *im, Vertex *va, Vertex *vb); static void display_help(Image *im); static void recolor_image(Image *im, float *lev, float *r, float *g, float *b, int n); /* * The following structure is used to describe menu fields to * CreateOptionMenu() and CreatePulldownMenu(). * Note that title options are denoted by setting callback=NULL, * and that separators are specified by setting label=NULL. */ typedef struct { char *label; /* The MenuItem label text */ XtCallbackProc callback; /* Function to be called when field is selected */ } MenuItem; static Widget CreateOptionMenu(char *name, char *label, Widget parent, int nopt, MenuItem *opts, XtPointer client_data); static Widget CreatePulldownMenu(char *name, char *label, Widget parent, int nfield, MenuItem *fields, XtPointer client_data); static Widget CreateMainMenuBar(Image *im, Widget w_main); static Widget CreatePopupPromptDialog(Widget w, char *name, char *prompt, char *value, XtCallbackProc ok_fn, XtPointer ok_data); static void start_slice_callback(Widget w, XtPointer client_data, XtPointer call_data); static void end_slice_callback(Widget w, XtPointer client_data, XtPointer call_data); static CALL_FN(quit_callback); static CALL_FN(help_callback); static CALL_FN(save_image_as_callback); static CALL_FN(save_image_callback); static CALL_FN(destroy_widget_callback); static void report_cursor(Widget w, XtPointer context, XEvent *event, Boolean *call_next); /*....................................................................... * A demo program showing an example of how to use PGPLOT with Motif. * * Output: * return int 0 - OK. * 1 - Error. */ int main(int argc, char *argv[]) { XtAppContext app;/* Application context returned by XtVaAppInitialize */ Widget w_top; /* The top-level widget of the application */ Widget w_main; /* The geometry management widget of the application */ Widget w_work; /* The work-area widget of the main window */ Image *im; /* Image object container */ /* * Initialize Motif. */ XtSetLanguageProc(NULL, NULL, NULL); w_top = XtVaAppInitialize(&app, "ImageSlice", NULL, 0, #if XtSpecificationRelease <= 4 (Cardinal *) #endif &argc, argv, NULL, XmNinput, True, NULL); /* * Use the standard Motif management widget layout. */ w_main = XtVaCreateManagedWidget("main", xmMainWindowWidgetClass, w_top, XmNscrollBarDisplayPolicy, XmAS_NEEDED, XmNscrollingPolicy, XmAUTOMATIC, XmNheight, 760, XmNwidth, 420, NULL); /* * Create a row-column widget to contain the two PGPLOT widgets and * an option-menu button. */ w_work = XtVaCreateManagedWidget("work", xmRowColumnWidgetClass, w_main, XmNorientation, XmVERTICAL, XmNnumColumns, 1, NULL); /* * Install the row-column widget as the work area of the main window. */ XtVaSetValues(w_main, XmNworkWindow, w_work, NULL); /* * Create the two PGPLOT widgets and the image container object. */ im = new_Image(MAP_SIZE, SLICE_SIZE, ring_fn, w_work, w_top); if(!im) return 1; /* * Create the application menu-bar. */ { Widget w_bar = CreateMainMenuBar(im, w_main); XtManageChild(w_bar); }; /* * Display the widgets. */ XtRealizeWidget(w_top); /* * Open the widgets to PGPLOT. */ if(cpgopen(xmp_device_name(im->w_image)) <= 0 || cpgopen(xmp_device_name(im->w_slice)) <= 0) return 1; /* * Display the initial image. */ display_fn(im, ring_fn); /* * Interact with the user. */ XtAppMainLoop(app); return 0; } /*....................................................................... * Allocate and return an initialized Image container object. * This function creates two PGPLOT widgets. One will be used to display * a gray-scale image. The other will be used to display a slice through * the image. * * Note that the widgets are not opened to PGPLOT and nothing * will be displayed until display_fn() is first * called. These operations must be postponed until after the widgets have * been realized. * * Input: * image_size unsigned The number of pixels along each side of the * square image array. This must be an odd * number (so that there can be a central pixel). * slice_size unsigned The dimension of the slice array (>=2). * fn IMAGE_FN(*) The initial display function. * parent Widget The widget in which to create the PGPLOT widgets. * w_top Widget The top-level widget of the application. * Output: * return Image * The new image container, or NULL on error. */ static Image *new_Image(unsigned image_size, unsigned slice_size, IMAGE_FN(*fn), Widget parent, Widget w_top) { Image *im; /* The pointer to the container to be returned */ Widget w_frame; /* A frame widget */ int i; /* * Check the arguments. */ if(image_size < 1 || image_size % 2 == 0) { fprintf(stderr, "new_Image: Illegal image size requested.\n"); return NULL; }; if(slice_size < 2) { fprintf(stderr, "new_Image: Illegal slice size requested.\n"); return NULL; }; if(!fn) { fprintf(stderr, "new_Image: NULL display function intercepted.\n"); return NULL; }; /* * Allocate the container. */ im = (Image *) malloc(sizeof(Image)); if(!im) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return NULL; }; /* * Before attempting any operation that might fail, initialize the * Image container at least up to the point at which it can safely be * passed to del_Image(). */ im->w_coord = NULL; im->w_image = NULL; im->w_slice = NULL; im->image = NULL; im->slice = NULL; im->image_size = image_size; im->slice_size = slice_size; im->scale = 40.0f/image_size; im->xa = -(int)image_size/2; im->xb = image_size/2; im->ya = -(int)image_size/2; im->yb = image_size/2; im->fn = fn; im->busy = None; im->w_top = w_top; /* * Now allocate the 2D image array as a 1D array to be indexed in * as a FORTRAN array. */ im->image = (float *) malloc(sizeof(float) * image_size * image_size); if(!im->image) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return del_Image(im); }; /* * Initialize the image array. */ for(i=0; iimage[i] = 0.0f; /* * Allocate an array to be used when constructing slices through the * displayed image. */ im->slice = (float *) malloc(sizeof(float) * slice_size); if(!im->slice) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return del_Image(im); }; /* * Initialize the slice array. */ for(i=0; islice[i] = 0.0f; /* * Create a horizontal row-column widget in which to arrange the * coordinate-display labels. */ w_frame = XtVaCreateManagedWidget("coord_row", xmRowColumnWidgetClass, parent, XmNorientation, XmHORIZONTAL, XmNnumColumns, 1, NULL); /* * Create two labels. The first will contain a prefix, and the second * will contain the coordinates. */ { char *text = "World coordinates: "; XtVaCreateManagedWidget("clab", xmLabelWidgetClass, w_frame, XtVaTypedArg, XmNlabelString, XmRString, text, strlen(text)+1, NULL); }; im->w_coord = XtVaCreateManagedWidget("coord", xmLabelWidgetClass, w_frame, XtVaTypedArg, XmNlabelString, XmRString, "", 1, NULL); /* * Create an etched-in frame widget to provide a border for the * image window. */ w_frame = XtVaCreateManagedWidget("image_frame", xmFrameWidgetClass, parent, XmNshadowType, XmSHADOW_IN, NULL); /* * Create the image-display widget. */ im->w_image = XtVaCreateManagedWidget("image", xmPgplotWidgetClass, w_frame, XmNheight, 400, XmNwidth, 400, XmpNmaxColors, 50, XmpNshare, True, XmNtraversalOn, False, NULL); /* * Register a motion-event callback such that the cursor position can * be reported in the im->w_coord label widget. */ XtAddEventHandler(im->w_image, PointerMotionMask, False, report_cursor, (XtPointer)im->w_coord); /* * Create a pulldown menu of optional 2-D image functions. */ { static MenuItem functions[] = { {"Display Functions", NULL}, /* Title */ {NULL, NULL}, /* Separator */ {"R=Polar radius", NULL}, /* Label */ {"A=Polar angle", NULL}, /* Label */ {NULL, NULL}, /* Separator */ {"cos(R)sin(A)", ring_callback}, {"sinc(R)", sinc_callback}, {"exp(-R^2/20.0)", gaus_callback}, {"sin(A)", sin_angle_callback}, {"cos(R)", cos_radius_callback}, {"(1+sin(6A))exp(-R^2/100)", star_callback}, }; Widget menu = CreateOptionMenu("functions", "Select a display function:", parent, sizeof(functions)/sizeof(functions[0]), functions, (XtPointer) im); if(menu == NULL) return del_Image(im); XtManageChild(menu); }; /* * Create a pulldown menu of optional color tables. */ { static MenuItem tables[] = { {"Color Tables", NULL}, /* Title */ {NULL, NULL}, /* Separator */ {"grey", grey_callback}, {"rainbow", rainbow_callback}, {"heat", heat_callback}, {"aips", aips_callback}, }; Widget menu = CreateOptionMenu("Colors", "Select a color table:", parent, sizeof(tables)/sizeof(tables[0]), tables, (XtPointer) im); if(menu == NULL) return del_Image(im); XtManageChild(menu); }; /* * Create an etched-in frame widget to provide a border for the * slice-plot window. */ w_frame = XtVaCreateManagedWidget("slice_frame", xmFrameWidgetClass, parent, XmNshadowType, XmSHADOW_IN, NULL); /* * Create the slice-display widget. */ im->w_slice = XtVaCreateManagedWidget("slice", xmPgplotWidgetClass, w_frame, XmNheight, 200, XmNwidth, 400, XmpNmaxColors, 16, XmpNshare, True, XmNtraversalOn, False, NULL); /* * Get the standard X busy cursor. */ im->busy = XCreateFontCursor(XtDisplay(im->w_top), XC_watch); return im; } /*....................................................................... * Delete an Image container previously returned by new_Image(). * * Input: * im Image * The container to be deleted (or NULL). * Output: * return Image * The deleted container (always NULL). */ Image *del_Image(Image *im) { if(im) { if(im->image) free(im->image); if(im->w_coord) XtDestroyWidget(im->w_coord); if(im->w_image) XtDestroyWidget(im->w_image); if(im->w_slice) XtDestroyWidget(im->w_slice); if(im->busy != None) XFreeCursor(XtDisplay(im->w_top), im->busy); free(im); }; return NULL; } /*....................................................................... * Display a new function in the image window. * * Input: * im Image * The image context object. * fn IMAGE_FN(*) The function to be displayed. */ static void display_fn(Image *im, IMAGE_FN(*fn)) { int ix, iy; /* The pixel coordinates being assigned */ float vmin; /* The minimum pixel value in the image */ float vmax; /* The maximum pixel value in the image */ float *pixel;/* A pointer to pixel (ix,iy) in im->image */ /* * Check arguments. */ if(!fn) { fprintf(stderr, "display_fn: NULL function.\n"); return; }; /* * Disarm the cursor while the image-plot is incomplete. */ xmp_disarm_cursor(im->w_image); /* * Install the new function. */ im->fn = fn; /* * Fill the image array via the current display function. */ pixel = im->image; vmin = vmax = im->fn(im->xa * im->scale, im->ya * im->scale); for(iy = im->ya; iy <= im->yb; iy++) { for(ix = im->xa; ix <= im->xb; ix++) { float value = im->fn(ix * im->scale, iy * im->scale); *pixel++ = value; if(value < vmin) vmin = value; if(value > vmax) vmax = value; }; }; /* * Record the min and max values of the data array. */ im->datamin = vmin; im->datamax = vmax; /* * Display the new image. */ display_image(im, xmp_device_id(im->w_image)); /* * Arm the cursor for user selection of the start position of the * first slice line through this image. */ xmp_arm_cursor(im->w_image, XMP_NORM_CURSOR, 0.0f, 0.0f, start_slice_callback, im); /* * Display instructions in the slice window. */ display_help(im); return; } /*....................................................................... * Display the current image function in a specified PGPLOT device. * * * Input: * im Image * The image context object. * id int The id of the PGPLOT device to display. */ static void display_image(Image *im, int id) { int minind,maxind; /* The range of available color indexes */ float tr[6]; /* Image coordinate-transformation matrix */ /* * Since rendering a gray-scale image takes a few seconds * display the busy cursor. */ XDefineCursor(XtDisplay(im->w_top), XtWindow(im->w_top), im->busy); XFlush(XtDisplay(im->w_top)); /* * Select the specified PGPLOT device and display the image array. */ cpgslct(id); cpgask(0); cpgpage(); cpgsch(1.0f); cpgvstd(); cpgwnad(im->xa * im->scale, im->xb * im->scale, im->ya * im->scale, im->yb * im->scale); /* * Set up the pixel -> world coordinate transformation matrix. */ tr[0] = (im->xa - 1) * im->scale; tr[1] = im->scale; tr[2] = 0.0f; tr[3] = (im->ya - 1) * im->scale; tr[4] = 0.0f; tr[5] = im->scale; /* * If there are fewer than 2 colors available for plotting images, * mark the image as monochrome so that pggray can be asked to * produce a stipple version of the image. */ cpgqcir(&minind, &maxind); if(maxind-minind+1 <= 2) { cpggray(im->image, im->image_size, im->image_size, 1, im->image_size, 1, im->image_size, im->datamax, im->datamin, tr); } else { cpgimag(im->image, im->image_size, im->image_size, 1, im->image_size, 1, im->image_size, im->datamin, im->datamax, tr); }; cpgsci(1); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("X", "Y", "Image display demo"); /* * Revert to the normal X cursor. */ XDefineCursor(XtDisplay(im->w_top), XtWindow(im->w_top), None); return; } /*....................................................................... * Display a new slice in the slice window. * * Input: * im Image * The image context object. * va Vertex * The vertex of one end of the slice line. * vb Vertex * The vertex of the opposite end of the slice line. */ static void display_slice(Image *im, Vertex *va, Vertex *vb) { float xa; /* The start X value of the slice */ float dx; /* The X-axis world-coordinate width of one slice pixel */ float ya; /* The start Y value of the slice */ float dy; /* The Y-axis world-coordinate width of one slice pixel */ float smin;/* The minimum slice value */ float smax;/* The maximum slice value */ float slice_length; /* The world-coordinate length of the slice */ float ymargin; /* The Y axis margin within the plot */ int i; /* * Determine the slice pixel assignments. */ xa = va->x; dx = (vb->x - va->x) / im->slice_size; ya = va->y; dy = (vb->y - va->y) / im->slice_size; /* * Make sure that the slice has a finite length by setting a * minimum size of one pixel. */ { float min_delta = im->scale / im->slice_size; if(fabs(dx) < min_delta && fabs(dy) < min_delta) dx = min_delta; }; /* * Construct the slice in im->slice[] and keep a tally of the * range of slice values seen. */ for(i=0; islice_size; i++) { float value = im->fn(xa + i * dx, ya + i * dy); im->slice[i] = value; if(i==0) { smin = smax = value; } else if(value < smin) { smin = value; } else if(value > smax) { smax = value; }; }; /* * Determine the length of the slice. */ { float xlen = dx * im->slice_size; float ylen = dy * im->slice_size; slice_length = sqrt(xlen * xlen + ylen * ylen); }; /* * Determine the extra length to add to the Y axis to prevent the * slice plot hitting the top and bottom of the plot. */ ymargin = 0.05 * (im->datamax - im->datamin); /* * Set up the slice axes. */ cpgslct(xmp_device_id(im->w_slice)); cpgask(0); cpgpage(); cpgbbuf(); cpgsch(2.0f); cpgvstd(); cpgswin(0.0f, slice_length, im->datamin - ymargin, im->datamax + ymargin); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("Radius", "Image value", "A 1D slice through the image"); /* * Draw the slice. */ for(i=0; islice_size; i++) { if(i==0) cpgmove(0.0f, im->slice[0]); else cpgdraw(slice_length * (float)i / (float)im->slice_size, im->slice[i]); }; cpgebuf(); return; } /*....................................................................... * Display usage instructions in the slice window. * * Input: * im Image * The image object. */ static void display_help(Image *im) { /* * Clear the slice plot and replace it with instructional text. */ cpgslct(xmp_device_id(im->w_slice)); cpgask(0); cpgpage(); cpgsch(3.5f); cpgsvp(0.0, 1.0, 0.0, 1.0); cpgswin(0.0, 1.0, 0.0, 1.0); cpgmtxt("T", -2.0, 0.5, 0.5, "To see a slice through the image, move the"); cpgmtxt("T", -3.0, 0.5, 0.5, "mouse into the image display window and select"); cpgmtxt("T", -4.0, 0.5, 0.5, " the two end points of a line."); } /*....................................................................... * A sinc(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sinc_fn) { const float tiny = 1.0e-6f; float radius = sqrt(x*x + y*y); return (fabs(radius) < tiny) ? 1.0f : sin(radius)/radius; } /*....................................................................... * Callback to select the sinc_fn() fucntion. */ static CALL_FN(sinc_callback) { display_fn((Image *) client_data, sinc_fn); } /*....................................................................... * A exp(-(x^2+y^2)/20) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(gaus_fn) { return exp(-((x*x)+(y*y))/20.0f); } /*....................................................................... * Callback to select the gaus_fn() fucntion. */ static CALL_FN(gaus_callback) { display_fn((Image *) client_data, gaus_fn); } /*....................................................................... * A cos(radius)*sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(ring_fn) { return cos(sqrt(x*x + y*y)) * sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * Callback to select the ring_fn() fucntion. */ static CALL_FN(ring_callback) { display_fn((Image *) client_data, ring_fn); } /*....................................................................... * A sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sin_angle_fn) { return sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * Callback to select the sin_angle_fn() fucntion. */ static CALL_FN(sin_angle_callback) { display_fn((Image *) client_data, sin_angle_fn); } /*....................................................................... * A cos(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(cos_radius_fn) { return cos(sqrt(x*x + y*y)); } /*....................................................................... * Callback to select the cos_radius_fn() fucntion. */ static CALL_FN(cos_radius_callback) { display_fn((Image *) client_data, cos_radius_fn); } /*....................................................................... * A (1+sin(6*angle))*exp(-radius^2 / 100)function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(star_fn) { return (1.0 + sin(x==0.0f && y==0.0f ? 0.0f : 6.0*atan2(x,y))) * exp(-((x*x)+(y*y))/100.0f); } /*....................................................................... * Callback to select the star_fn() fucntion. */ static CALL_FN(star_callback) { display_fn((Image *) client_data, star_fn); } /*....................................................................... * Create an option menu. * * Input: * name char * The name of the menu. * label char * The instructive label to place to the left of * the option menu. * parent Widget The widget in which to place the option menu. * nopt int The number of option fields. * opts MenuItem * An array of nopt option fields. * client_data XtPointer The client_data argument to be passed to each * callback function. * Output: * return Widget The menu, or NULL on error. */ static Widget CreateOptionMenu(char *name, char *label, Widget parent, int nopt, MenuItem *opts, XtPointer client_data) { Widget w_menu; /* The option menu to be returned */ Widget w_pulldown; /* The pulldown-menu of the option menu widget */ int i; /* * Check arguments. */ if(nopt < 1 || !opts) { fprintf(stderr, "CreateOptionMenu: No options.\n"); return NULL; }; /* * Create a pulldown menu. */ w_pulldown = XmCreatePulldownMenu(parent, "pulldown", NULL, 0); /* * Create the option-menu button to attach the menu to. */ { XmString label_str = XmStringCreateSimple(label); Arg args[5]; /* Resource arguments for XmCreateOptionMenu() */ int narg = 0; XtSetArg(args[narg], XmNsubMenuId, w_pulldown); narg++; XtSetArg(args[narg], XmNlabelString, label_str); narg++; w_menu = XmCreateOptionMenu(parent, name, args, narg); XmStringFree(label_str); }; /* * Install the option fields. */ for(i=0; ilabel) { /* * Add an option field. */ if(opt->callback) { Widget widget = XtVaCreateManagedWidget(opt->label, xmPushButtonWidgetClass, w_pulldown, NULL); XtAddCallback(widget, XmNactivateCallback, opt->callback, client_data); /* * Add a title widget. */ } else { XtVaCreateManagedWidget(opt->label, xmLabelGadgetClass, w_pulldown, XmNalignment, XmALIGNMENT_BEGINNING, NULL); }; /* * Add a separator widget. */ } else { XtVaCreateManagedWidget("separator", xmSeparatorGadgetClass, w_pulldown, NULL); }; }; return w_menu; } /*....................................................................... * Create a pulldown menu. * * Input: * name char * The name of the menu. * label char * The label for the menubar button. * parent Widget The widget in which to place the pulldown menu. * nfield int The number of menu fields. * fields MenuItem * An array of nfield menu fields. * client_data XtPointer The client_data argument to be passed to each * callback function. * Output: * return Widget The cascade button of the menu, or NULL on error. */ static Widget CreatePulldownMenu(char *name, char *label, Widget parent, int nfield, MenuItem *fields, XtPointer client_data) { Widget w_pulldown; /* The pulldown-menu */ Widget w_cascade; /* The cascade button to be returned */ int i; /* * Check arguments. */ if(nfield < 1 || !fields) { fprintf(stderr, "CreatePulldownMenu: No fields.\n"); return NULL; }; /* * Create a pulldown menu. */ w_pulldown = XmCreatePulldownMenu(parent, "pulldown", NULL, 0); /* * Create the cascade button that invokes the menu. */ { XmString label_str = XmStringCreateSimple(label); w_cascade = XtVaCreateManagedWidget(name, xmCascadeButtonWidgetClass, parent, XmNsubMenuId, w_pulldown, XmNlabelString, label_str, NULL); XmStringFree(label_str); }; /* * Install the menu fields. */ for(i=0; ilabel) { /* * Add a button widget. */ if(field->callback) { Widget widget = XtVaCreateManagedWidget(field->label, xmPushButtonWidgetClass, w_pulldown, NULL); XtAddCallback(widget, XmNactivateCallback, field->callback, client_data); /* * Add a title widget. */ } else { XtVaCreateManagedWidget(field->label, xmLabelGadgetClass, w_pulldown, XmNalignment, XmALIGNMENT_BEGINNING, NULL); }; /* * Add a separator widget. */ } else { XtVaCreateManagedWidget("separator", xmSeparatorGadgetClass, w_pulldown, NULL); }; }; return w_cascade; } /*....................................................................... * This callback is called when the user selects the start position * of a slice line. * * Input: * Widget widget The PGPLOT widget that had a cursor event. * client_data XtPointer The optional client data pointer passed to * xmp_arm_cursor(). * call_data XtPointer The pointer to the context of the event * as a (XmpCursorCallbackStruct *) cast to * (XtPointer). */ static void start_slice_callback(Widget w, XtPointer client_data, XtPointer call_data) { XmpCursorCallbackStruct *cursor = (XmpCursorCallbackStruct *) call_data; Image *im = (Image *) client_data; im->va.x = cursor->x; im->va.y = cursor->y; /* * Display a line-oriented rubber-band cursor to get the end vertex of the * line. */ cpgslct(xmp_device_id(im->w_image)); cpgsci(3); xmp_arm_cursor(im->w_image, XMP_LINE_CURSOR, im->va.x, im->va.y, end_slice_callback, im); } /*....................................................................... * This callback is called when the user selects the end position * of a slice line. * * Input: * Widget widget The PGPLOT widget that had a cursor event. * client_data XtPointer The optional client data pointer passed to * xmp_arm_cursor(). * call_data XtPointer The pointer to the context of the event * as a (XmpCursorCallbackStruct *) cast to * (XtPointer). */ static void end_slice_callback(Widget w, XtPointer client_data, XtPointer call_data) { XmpCursorCallbackStruct *cursor = (XmpCursorCallbackStruct *) call_data; Image *im = (Image *) client_data; im->vb.x = cursor->x; im->vb.y = cursor->y; /* * Re-arm the cursor for the start of the next line. */ xmp_arm_cursor(im->w_image, XMP_NORM_CURSOR, 0.0f, 0.0f, start_slice_callback, im); /* * Draw the slice wrt the new line. */ display_slice(im, &im->va, &im->vb); } /*....................................................................... * Create the menu bar of the application. * * Input: * im Image * The image object of the application. * w_main Widget The main widget of the application. * Output: * return Widget The menu-bar widget or NULL on error. */ static Widget CreateMainMenuBar(Image *im, Widget w_main) { Widget w_bar; /* The menu-bar widget */ /* * Create the menu bar with File and Help menus. */ w_bar = XmCreateMenuBar(w_main, "menubar", NULL, 0); /* * Install the File menu. */ { static MenuItem file_fields[] = { {"Save image as", save_image_as_callback}, {NULL, NULL}, /* Separator */ {"Quit", quit_callback} }; CreatePulldownMenu("file_menu", "File", w_bar, sizeof(file_fields)/sizeof(file_fields[0]), file_fields, (XtPointer) im); }; /* * Install the Help menu. */ { static MenuItem help_fields[] = { {"Usage", help_callback} }; Widget w_help = CreatePulldownMenu("help_menu", "Help", w_bar, sizeof(help_fields)/sizeof(help_fields[0]), help_fields, (XtPointer) im); XtVaSetValues(w_bar, XmNmenuHelpWidget, w_help, NULL); }; return w_bar; } /*....................................................................... * The file-menu "Quit" callback function. */ static CALL_FN(quit_callback) { exit(0); } /*....................................................................... * The help-menu callback function. */ static CALL_FN(help_callback) { Image *im = (Image *) client_data; display_help(im); } /*....................................................................... * The File-menu "save image as" callback. */ static CALL_FN(save_image_as_callback) { Image *im = (Image *) client_data; Widget w_dialog = CreatePopupPromptDialog(w, "device", "Enter a PGPLOT device string:", "image.ps/vps", save_image_callback, (XtPointer) im); /* * Add a null translation for the letter '?'. This prevents users from * enterring a PGPLOT '?' query string. */ { char *bindings ="s \?:"; XtTranslations translations = XtParseTranslationTable(bindings); XtOverrideTranslations(XmSelectionBoxGetChild(w_dialog, XmDIALOG_TEXT), translations); }; /* * Display the dialog. */ XtManageChild(w_dialog); XtPopup(XtParent(w_dialog), XtGrabNone); } /*....................................................................... * The callback for the dialog created by save_image_as_callback(). */ static CALL_FN(save_image_callback) { int device_id; /* The PGPLOT ID of the new PGPLOT device */ Image *im = (Image *) client_data; XmSelectionBoxCallbackStruct *sel = (XmSelectionBoxCallbackStruct *) call_data; /* * Translate the device specification into a normal C string. */ { char *device = NULL; if(XmStringGetLtoR(sel->value, XmFONTLIST_DEFAULT_TAG, &device)) { /* * Open the specified device. */ device_id = cpgopen(device); XtFree(device); if(device_id > 0) { display_image(im, device_id); cpgclos(); }; } }; /* * Discard the popup widget. */ XtDestroyWidget(w); return; } /*....................................................................... * Create a popup prompt-dialog with a specified prompt and initial value. * * Input: * w Widget The widget of the button that invoked the dialog. * name char * The name to give the popup. Note that * XmCreatePromptDialog() appends _prompt to this. * prompt char * The dialog prompt string. * value char * The initial value to display, or NULL. * ok_fn XtCallbackProc The callback function for the OK button. * ok_data XtPointer The callback client_data argument. * Output: * return Widget The dialog widget. */ static Widget CreatePopupPromptDialog(Widget w, char *name, char *prompt, char *value, XtCallbackProc ok_fn, XtPointer ok_data) { Widget w_dialog; /* The dialog widget to be returned */ /* * Create the dialog. */ { XmString prompt_str = XmStringCreateSimple(prompt); Arg args[5]; int n = 0; XtSetArg(args[n], XmNselectionLabelString, prompt_str); n++; XtSetArg(args[n], XmNautoUnmanage, False); n++; w_dialog = XmCreatePromptDialog(w, name, args, n); XmStringFree(prompt_str); }; /* * Arrange to ignore the Cancel button. */ XtAddCallback(w_dialog, XmNcancelCallback, destroy_widget_callback, NULL); /* * Install the provided Ok callback and its client_data. */ if(ok_fn) XtAddCallback(w_dialog, XmNokCallback, ok_fn, ok_data); /* * De-sensitize the Help button. */ XtSetSensitive(XmSelectionBoxGetChild(w_dialog, XmDIALOG_HELP_BUTTON), False); /* * Install the initial text-field value. */ if(value) { XtVaSetValues(XmSelectionBoxGetChild(w_dialog, XmDIALOG_TEXT), XmNvalue, value, XmNcursorPosition, (XmTextPosition) strlen(value), NULL); }; /* * Add emacs-like keybindings. */ { char *bindings ="\ c a: beginning-of-line()\n\ c e: end-of-line()\n\ c b: backward-character()\n\ c f: forward-character()\n\ c u: select-all() delete-selection()\n\ c d: delete-next-character()\ "; XtTranslations translations = XtParseTranslationTable(bindings); XtOverrideTranslations(XmSelectionBoxGetChild(w_dialog, XmDIALOG_TEXT), translations); }; return w_dialog; } /*....................................................................... * A callback that destroys its widget. */ static CALL_FN(destroy_widget_callback) { XtDestroyWidget(w); } /*....................................................................... * This is a motion-event callback for the image window. It reports the * current position of the cursor in world coordinates. * * Input: * w Widget The im->w_image PGPLOT widget. * context XtPointer The im->w_coord label widget cast to XtPointer. * event XEvent * The motion event. * call_next Boolean * *call_next will be left as True so that any * following event handlers will get called. */ static void report_cursor(Widget w, XtPointer context, XEvent *event, Boolean *call_next) { Widget w_coord = (Widget) context; if(event->type == MotionNotify) { char text[80]; float wx, wy; /* * Convert from X-window coordinates to world coordinates. */ if(xmp_pixel_to_world(w, event->xmotion.x, event->xmotion.y, &wx, &wy) == 0) { sprintf(text, "X=%-10g Y=%-10g", wx, wy); XtVaSetValues(w_coord, XtVaTypedArg, XmNlabelString, XmRString, text, strlen(text)+1, NULL); }; }; *call_next = True; } /*....................................................................... * Callback to select a grey colormap fucntion. */ static CALL_FN(grey_callback) { static float grey_l[] = {0.0, 1.0}; static float grey_c[] = {0.0, 1.0}; recolor_image((Image *) client_data, grey_l, grey_c, grey_c, grey_c, sizeof(grey_l)/sizeof(grey_l[0])); } /*....................................................................... * Callback to select a rainbow colormap fucntion. */ static CALL_FN(rainbow_callback) { static float rain_l[] = {-0.5, 0.0, 0.17, 0.33, 0.50, 0.67, 0.83, 1.0, 1.7}; static float rain_r[] = { 0.0, 0.0, 0.0, 0.0, 0.6, 1.0, 1.0, 1.0, 1.0}; static float rain_g[] = { 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.6, 0.0, 1.0}; static float rain_b[] = { 0.0, 0.3, 0.8, 1.0, 0.3, 0.0, 0.0, 0.0, 1.0}; recolor_image((Image *) client_data, rain_l, rain_r, rain_g, rain_b, sizeof(rain_l)/sizeof(rain_l[0])); } /*....................................................................... * Callback to select the IRAF "heat" colormap fucntion. */ static CALL_FN(heat_callback) { static float heat_l[] = {0.0, 0.2, 0.4, 0.6, 1.0}; static float heat_r[] = {0.0, 0.5, 1.0, 1.0, 1.0}; static float heat_g[] = {0.0, 0.0, 0.5, 1.0, 1.0}; static float heat_b[] = {0.0, 0.0, 0.0, 0.3, 1.0}; recolor_image((Image *) client_data, heat_l, heat_r, heat_g, heat_b, sizeof(heat_l)/sizeof(heat_l[0])); } /*....................................................................... * Callback to select the aips tvfiddle colormap fucntion. */ static CALL_FN(aips_callback) { static float aips_l[] = {0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4, 0.5, 0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9, 1.0}; static float aips_r[] = {0.0, 0.0, 0.3, 0.3, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0}; static float aips_g[] = {0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.8, 0.8, 0.6, 0.6, 1.0, 1.0, 1.0, 1.0, 0.8, 0.8, 0.0, 0.0}; static float aips_b[] = {0.0, 0.0, 0.3, 0.3, 0.7, 0.7, 0.7, 0.7, 0.9, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0}; recolor_image((Image *) client_data, aips_l, aips_r, aips_g, aips_b, sizeof(aips_l)/sizeof(aips_l[0])); } /*....................................................................... * Change the colors used to display the current image. * * Inputs: * im Image * The image widget resource object. * lev float * The array of n normalized brightness levels at which * red,green and blue levels are to be defined. * r float * The red brightness at each of the levels in lev[]. * g float * The green brightness at each of the levels in lev[]. * b float * The blue brightness at each of the levels in lev[]. * n int The number of values in each of lev[],r[],g[] and b[]. */ static void recolor_image(Image *im, float *lev, float *r, float *g, float *b, int n) { Boolean share; /* True if the widget colors are readonly */ /* * Select the image PGPLOT widget and redefine its colors. */ cpgslct(xmp_device_id(im->w_image)); cpgctab(lev, r, g, b, n, 1.0, 0.5); /* * If the widget's colors were allocated readonly, redraw the image * to reveal the new colors. */ XtVaGetValues(im->w_image, XmpNshare, &share, NULL); if(share) display_image(im, xmp_device_id(im->w_image)); } ice(im, &im->va, &im->vb); } /*....................................................................... * Create the menu bar of the application. * * Input: * im Image * The image object of the application. * w_main Widget The main widget of the application. * Output: * return Widget The menu-barpgplot/drivers/nedriv.f010064400040640000322000000354650627641776500157070ustar00tjpcitmbr00000400000017C*NEDRIV -- PGPLOT NeXTstep driver C+ SUBROUTINE NEDRIV(IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for NeXT computers. C C 1992-Feb-16 - Copied from psdriv.f - [AFT] C C Supported device: C Any computer running NeXTstep. C C Device type code: C /NEXT C C Default file name: C none C C Default view surface dimensions: C The default screen size is 720 by 535 pixels (about 8 by 6 inches C on a 19 inch monitor). The aspect ratio was selected to match C the /PS device. The window can be resized larger or smaller. C C Resolution: C The screen resolution is 92 dpi. The driver generates PostScript C commands with a resolution 10 times greater than the screen resolution. C This allows the window to be resized and/or a hardcopy to be made with C no loss of resolution. C C Color capability: C On all devices, color indices 0-15 are supported. The default colors C are 0 is white, 1 is black, 14 is light gray, 15 dark gray. On C monochrome devices, color indices 2-13 default to black. If the C driver detects a color server, then color indices 0-255 are allowed C and color indices 2-13 default to the standard PGPLOT colors. C C Input capability: C The PGPLOT cursor is supported. When a cursor read is requested the C the viewer becomes the active application and the active plot window C becomes the key window. This allows the user to terminate the cursor C read by either a mouse click (which generates an 'A' character) or C by pressing a key on the keyboard. C C File format: C By using the print command, in the main menu, you can send the C contents of the current window to a file. This file can then be C printed on any PostScript printer. C C Obtaining hardcopy: C If you click on the print item in the main menu, then the standard C NeXT print panel comes up. This allows the contents of the current C window to be sent to a printer, disk file or previewer. C C References: C C (1) Adobe Systems, Inc.: PostScript Language Reference Manual. C Addison-Wesley, Reading, Massachusetts, 1985. C (2) Adobe Systems, Inc.: PostScript Language Tutorial and Cookbook. C Addison-Wesley, Reading, Massachusetts, 1985. C (3) Adobe Systems, Inc.: PostScript Language Reference Manual, Second C Edition. Addison-Wesley, Reading, Massachusetts, 1990. C (4) Adobe Systems, Inc.: Programming the Display PostScript System C with NeXTstep. Addison-Wesley, Reading, Massachusetts, 1992. C----------------------------------------------------------------------- CHARACTER*(*) DTYPE PARAMETER (DTYPE= 'NEXT (Display on NeXT console)') CHARACTER*120 INSTR, MSG CHARACTER CBUF*4 REAL RTMP(4) INTEGER HEIGHT, RESOL, WIDTH SAVE HEIGHT, RESOL, WIDTH INTEGER LASTI, LASTJ, NPTS SAVE LASTI, LASTJ, NPTS INTEGER CI, LW INTEGER I0, J0, I1, J1, L INTEGER NXP, NYP, XORG, YORG, XLEN, YLEN, N, RGB(3) INTEGER HIGH, LOW, I, K, KMAX LOGICAL START, COLOR SAVE START, COLOR REAL RVALUE(0:255), GVALUE(0:255), BVALUE(0:255) SAVE RVALUE, GVALUE, BVALUE C REAL SHADE(0:15), RINIT(0:15), GINIT(0:15), BINIT(0:15) SAVE SHADE, RINIT, GINIT, BINIT CHARACTER*1 HEXDIG(0:15) DATA HEXDIG/'0','1','2','3','4','5','6','7', 1 '8','9','A','B','C','D','E','F'/ DATA SHADE /1.00, 13*0.00, 0.33, 0.67/ DATA RINIT 1 / 1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 2 1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67/ DATA GINIT 1 / 1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00, 2 0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67/ DATA BINIT 1 / 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00, 2 0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67/ DATA WIDTH,HEIGHT/0.,0./ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,900,900,260,900,900,290), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CONTINUE CHR = DTYPE LCHR = LEN(DTYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE IF(HEIGHT.EQ.0.) THEN CALL NEXSUP(1,CBUF,RTMP) HEIGHT = RTMP(1) WIDTH = RTMP(2) RESOL = RTMP(3) END IF RBUF(1) = 0 RBUF(3) = 0 RBUF(5) = 0 RBUF(2) = HEIGHT-1 RBUF(4) = WIDTH-1 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 CONTINUE IF(HEIGHT.EQ.0.) THEN CALL NEXSUP(1,CBUF,RTMP) HEIGHT = RTMP(1) WIDTH = RTMP(2) RESOL = RTMP(3) END IF RBUF(1) = RESOL*92.0 RBUF(2) = RESOL*92.0 RBUF(3) = 5 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor, No dashed lines, Area fill, C Thick lines, No Rectangle fill, Array images.) C 40 CHR = 'ICNATNQNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CONTINUE CHR = ' ' LCHR = 0 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE IF(HEIGHT.EQ.0.) THEN CALL NEXSUP(1,CBUF,RTMP) HEIGHT = RTMP(1) WIDTH = RTMP(2) RESOL = RTMP(3) END IF RBUF(1) = 0 RBUF(3) = 0 RBUF(2) = HEIGHT-1 RBUF(4) = WIDTH-1 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 8 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE CALL NEXSUP(1,CBUF,RTMP) COLOR = RTMP(4).NE.0.0 IF (COLOR) THEN DO 91 CI=0,15 RVALUE(CI) = RINIT(CI) GVALUE(CI) = GINIT(CI) BVALUE(CI) = BINIT(CI) 91 CONTINUE ELSE DO 92 CI=0,15 RVALUE(CI) = SHADE(CI) GVALUE(CI) = SHADE(CI) BVALUE(CI) = SHADE(CI) 92 CONTINUE END IF DO 93 CI=16,255 RVALUE(CI) = 0.0 GVALUE(CI) = 0.0 BVALUE(CI) = 0.0 93 CONTINUE C LASTI = -1 LASTJ = -1 NPTS = 0 C RBUF(1) = 1 RBUF(2) = 1 NBUF = 2 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE CALL NEXSUP(7,CBUF,RTMP) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C If user has deleted window, create a new one now. CALL NEXSUP(1,CBUF,RTMP) HEIGHT = RTMP(1) WIDTH = RTMP(2) RESOL = RTMP(3) COLOR = RTMP(4).NE.0.0 C Send begin picture message. CALL NEXSUP(2,CBUF,RTMP) C The following line clears the screen. CALL GRFAO('1.0 setgray 0 0 # # rectfill', L, INSTR, : HEIGHT, WIDTH, 0, 0) CALL GRNE02(0, INSTR(:L), 0) CALL GRNE02(0, '1 setlinejoin 1 setlinecap 1 SLW', 0) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN CALL GRFAO('# # c', L, INSTR, (I1-I0), (J1-J0), 0, 0) ELSE CALL GRFAO('# # # # l', L, INSTR, (I1-I0), (J1-J0), I0, J0) END IF LASTI = I1 LASTJ = J1 CALL GRNE02(0, INSTR(:L), 0) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) CALL GRFAO('# # d', L, INSTR, I1, J1, 0, 0) LASTI = I1 LASTJ = J1 CALL GRNE02(0, INSTR(:L), 0) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE CALL GRNE02(0, ' ', 1) CALL NEXSUP(6, CBUF, RTMP) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) IF (COLOR) THEN WRITE(INSTR,151) RVALUE(CI), GVALUE(CI), BVALUE(CI) 151 FORMAT(3(F5.3,1X),'setrgbcolor') L = 29 ELSE WRITE(INSTR,'(F5.3,1X,''setgray'')') RVALUE(CI) L = 13 END IF LASTI = -1 CALL GRNE02(0, INSTR(:L), 0) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE CALL GRNE02(0, ' ', 1) CALL NEXSUP(5, CBUF, RTMP) LASTI=-1 RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C 170 CONTINUE CALL NEXSUP(4, CBUF, RTMP) RBUF(1)=RTMP(1) RBUF(2)=RTMP(2) NBUF=2 CHR(1:1)=CHAR(NINT(RTMP(3))) LCHR=1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) START = .TRUE. RETURN ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) IF (START) THEN CALL GRFAO('# # BP', L, INSTR, I0, J0, 0, 0) START = .FALSE. LASTI = I0 LASTJ = J0 ELSE IF (NPTS.EQ.0) THEN CALL GRFAO('# # EP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = -1 LASTJ = -1 ELSE CALL GRFAO('# # LP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = I0 LASTJ = J0 END IF CALL GRNE02(0, INSTR(:L), 0) RETURN END IF C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (COLOR) THEN CI = RBUF(1) RVALUE(CI) = RBUF(2) GVALUE(CI) = RBUF(3) BVALUE(CI) = RBUF(4) ELSE CI = RBUF(1) RVALUE(CI) = 0.30*RBUF(2) + 0.59*RBUF(3) + 0.11*RBUF(4) GVALUE(CI) = RVALUE(CI) BVALUE(CI) = RVALUE(CI) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE LW = NINT(RBUF(1)) CALL GRFAO('# SLW', L, INSTR, LW, 0, 0, 0) LASTI = -1 CALL GRNE02(0, INSTR(:L), 0) RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE CALL GRNE02(0, CHR(:LCHR), 1) LASTI = -1 RETURN C C--- IFUNC=26, Image.--------------------------------------------------- C 260 CONTINUE N = RBUF(1) IF (N.EQ.0) THEN C -- First: setup for image C -- Set clipping region (RBUF(2...5)) NXP = RBUF(2) NYP = RBUF(3) XORG = RBUF(4) XLEN = RBUF(5) - RBUF(4) YLEN = RBUF(7) - RBUF(6) YORG = RBUF(6) CALL GRNE02(0, 'gsave newpath', 0) CALL GRFAO('# # moveto # 0 rlineto 0 # rlineto', L, INSTR, : XORG, YORG, XLEN, YLEN) CALL GRNE02(0, INSTR(:L), 0) CALL GRFAO('# 0 rlineto closepath clip', L, INSTR, -XLEN, : 0, 0, 0) CALL GRNE02(0, INSTR(:L), 0) C -- CALL GRFAO('/picstr # string def', L, INSTR, NXP, 0, 0, 0) CALL GRNE02(0, INSTR(:L), 0) CALL GRFAO('# # 8 [', L, INSTR, NXP, NYP, 0, 0) CALL GRNE02(0, INSTR(:L), 0) WRITE (INSTR, '(6(1PE10.3, 1X), '']'')') (RBUF(I),I=8,13) CALL GRNE02(0, INSTR(:67), 0) IF (COLOR) THEN CALL GRNE02(0, : '{currentfile picstr readhexstring pop} false 3 colorimage',0) ELSE CALL GRNE02(0, : '{currentfile picstr readhexstring pop} image',0) END IF ELSE IF (N.EQ.-1) THEN C -- Last: terminate image CALL GRNE02(0, 'grestore', 0) ELSE C -- Middle: write N image pixels; each pixel uses 6 chars C in INSTR, so N must be <= 20. L = 0 KMAX = 1 IF (COLOR) KMAX = 3 DO 262 I=1,N CI = RBUF(I+1) RGB(1) = NINT(255.0*RVALUE(CI)) RGB(2) = NINT(255.0*GVALUE(CI)) RGB(3) = NINT(255.0*BVALUE(CI)) DO 261 K=1,KMAX HIGH = RGB(K)/16 LOW = RGB(K)-16*HIGH L = L+1 INSTR(L:L) = HEXDIG(HIGH) L = L+1 INSTR(L:L) = HEXDIG(LOW) 261 CONTINUE 262 CONTINUE CALL GRNE02(0, INSTR(1:L), 1) END IF RETURN C C--- IFUNC=29, Query color representation.------------------------------ C 290 CONTINUE CI = NINT(RBUF(1)) NBUF = 4 RBUF(2) = RVALUE(CI) RBUF(3) = GVALUE(CI) RBUF(4) = BVALUE(CI) RETURN C C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG, 901) IFUNC 901 FORMAT('Unimplemented function in PS device driver: ',I10) CALL GRWARN(MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END C*GRNE02 -- PGPLOT NeXT driver, buffer routine. C+ SUBROUTINE GRNE02(UNIT, CIN, IFLUSH) CHARACTER CIN*(*) INTEGER UNIT, IFLUSH C C Support routine for NEdriver: Add string to buffer, C flushing if needed. If IFLUSH>0 flush buffer. C----------------------------------------------------------------------- CHARACTER CBUF*132 INTEGER LBUF, LIN SAVE CBUF, LBUF REAL RTMP DATA LBUF/0/ C LIN = LEN(CIN) IF(LIN.GT.0) THEN IF(LBUF+LIN+1.GE.LEN(CBUF)) THEN CBUF(LBUF+1:LBUF+1)=CHAR(0) CALL NEXSUP(3, CBUF, RTMP) LBUF=0 END IF IF(LBUF.GT.0) THEN CBUF(LBUF+1:LBUF+1)=' ' LBUF=LBUF+1 END IF CBUF(LBUF+1:LBUF+LIN)=CIN LBUF=LBUF+LIN END IF IF(IFLUSH.GT.0) THEN IF(LBUF.GT.0) THEN CBUF(LBUF+1:LBUF+1)=CHAR(0) CALL NEXSUP(3, CBUF, RTMP) LBUF=0 END IF END IF C----------------------------------------------------------------------- END ---------- C 100 CONTINUE CALL NEXSUP(7,CBUF,RTMP) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C If user has deleted window, create a pgplot/drivers/txdriv.f010064400040640000322000005376320641627102300157200ustar00tjpcitmbr00000400000017C*TXDRIV -- driver for TeX PK Font output C+ SUBROUTINE TXDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE SAVE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for PGPLOT TeX PK Font Output files C (produces output files 'pgplot.300pk' and 'pgplot.tfm'), C {the 300 is dots/per inch and might be different if a C different resolution is used}). C C Device type code: /TX C C Supported device: PK Font files for TeX on a Vax or on MIPS. C C Default file names: 'pgplot.RESpk', 'pgplot.tfm' where the C "res" is a default value of 300 but may be set to something C else. If "res"=300, then the default file names would be C 'pgplot.300pk' and 'pgplot.tfm'. C If more than 15 font characters are produced, then the file C names become 'pgplot_2.300pk' and 'pgplot_2.tfm' ,etcetera C for each set of 15 characters output (i.e.- for each PK C font produced). C C Default view surface dimensions: 2.8 inches x 2.8 inches C (but may be overridden by the logicals PGPLOT_TX_YINCHES, C and PGPLOT_TX_XINCHES C { $DEFINE PGPLOT_TX_XINCHES "5.0" C $DEFINE PGPLOT_TX_YINCHES "4.5" C would provide a "view" surface of 5.0 inches horizontally C by 4.5 inches vertically.}). C { setenv PGPLOT_TX_XINCHES "5.0" C setenv PGPLOT_TX_YINCHES "4.5" C would be the equivalent UNIX command. Everywhere C you see the command $DEFINE... use the command C setenv... under UNIX}. C C Driver Size (H x V) inches C ------ ------------ C TX01 2.80 x 2.80 C C C C C Resolution: 300 dots per inch Horizontal and Vertical C (made be overridden by the logicals C PGPLOT_TX_XRESOL and PGPLOT_TX_YRESOL C { $DEFINE PGPLOT_TX_XRESOL "78.0" C $DEFINE PGPLOT_TX_YRESOL "78.0" C will produce a font at 78 dots per inch C resolution. This would be good for a C Vaxstation 2000 workstation.}). C The default 300 dots per inch is good for a C laser printer such as a QMS1200 LaserGrafix C or an HP2000 LaserJet. C-- C C+ C C Color capability: Color indices 0 (erase, white) C and 1 (black) are supported. It is not possible to C change color representation. C C Output Orientation: Portrait. (Can be overridden by the C logical PGPLOT_TX_ORIENT C { $DEFINE PGPLOT_TX_ORIENT "LANDSCAPE"}). C C Input capability: None. C C File formats: TeX PK Font file format, and TeX C TFM file format. The files are output as C FORTRAN, DIRECT ACCESS, UNFORMATTED, C 512 BYTE RECORDS so that we can have C compatability with the VAX and our C UNIX machine. {A raw bitmap copy is C also possible if you define the logical C PGPLOT_TX_BITFILE . C $ DEFINE PGPLOT_TX_BITFILE "MINIMAL" C will produce a file copy of the portion C of the bitmap which is within the minimal C bounding box of the character. C $ DEFINE PGPLOT_TX_BITFILE "ALL" will produce C a file copy of the complete bitmap of the C graphics character.} C C Obtaining hardcopy: Use the command DUMP to view the C output files, or run TeX and include the C character of this new font and DVI the output C and print the resulting binary file to the C correct printer (with PASSALL, NOFEED, or C whatever is required for printing binary C output to your specific printer). Also, the C PKTYPE and TFTOPL TeX debugging programs will C allow you to view your output font C characteristics. C C ---------------------------------------------------------------------- C C---------------------------------------------------------------------- C C+ C TeX Example: Assume you have produced a graph into a C PK Font and that the output file names are 'pgplot.300pk' C and 'pgplot.tfm' then the following lines in your TeX code C would include the graph corresponding to the letter "A" C of the TeX PK font "PGPLOT" in the middle of your paper: C C \font\myfntname=pgplot C This is sentence one of the TeX file. C Now I will include the character. C \centerline{\myfntname A } C This is the last sentence. C \bye C C Of course, you must tell TeX and the DVI driver where C to find your fonts. On our VAX, we have defined a C search list so that if you define the logical C TEX_USER_FONTS to be your directory where you keep your C fonts, then TeX and the DVI driver will find the C 'pgplot.tfm' file and the 'pgplot.300pk' file. So, C $DEFINE TEX_USER_FONTS SYS$USERDISK:[USERNAME.FONTS] C would cause TeX and the DVI driver to search the normal C search path and also the directory C SYS$USERDISK:[USERNAME.FONTS] for any fonts that you C specified in your TeX file. {Here is an exception for C the UNIX. Our UNIX TeX and DVI programs will look in your C current directory automatically for the fonts and then C will check the system library if it cannot find the C fonts in your directory. So you CANNOT setenv C TEX_USER_FONTS on our UNIX system...}. C C Notes: C You must change the resolution for different output C devices (our DVI driver, DVIHP, for our HP2000 LaserJet C would use a resolution of 300 dots per inch; while our C DVI driver for the Vaxstation 2000 workstation would C need a resolution of 78 dots per inch. The 'pgplot.tfm' C file would of course be the same in both cases, but the C DVI drivers would look for 'pgplot.300pk' and 'pgplot.78pk' C respectively). If you produce an image which is too large C (by defining logicals PGPLOT_TX_XINCHES and PGPLOT_TX_YINCHES) C then some DVI drivers will leave the page blank where the C graph of the character belongs (can sometimes use \hsize and C \vsize to help with this). Finally, if your device driver C only works with PXL files (like our PRINTRONIX DVI driver), C then you may want to run the PKTOPX program to convert C the PK Font into a PXL Font which your device driver needs. C ----------------------------------------------------------------------- C------------------------------------------------------------------------- C C+ C C C The above example for LaTeX would be: C C This is the first sentence. C Now I will include the character as a figure. C \begin{figure} C \newfont{\myfntname}{pgplot} C \centerline{\myfntname A} C \caption{Letter A of PGPLOT font} C \end{figure} C This is the last sentence. C C And you would need to define TEX_USER_FONTS on the Vax C as before {but again, not under UNIX}. C --------------------------------------------------------------------- C C Version 1.2 - 24-SEP-1989 - Bob Forrest, Electrical Engineering Dept. C Texas A&M University; College Station,Texas 77843 C bitnet: FORREST@TAMVXEE C internet: forrest@ee.tamu.edu C ---------------------------------------------------------------------- C---------------------------------------------------------------------- C C *** Note: SAVE statement is required in this routine, TXDRIV, and C *** in routines GRTX11 and GRTX12. The values of some of C *** the variables in each of these 3 routines are required C *** upon entry to remain the same as the last time the routine was C *** executed. C C *** PORTABILITY NOTES: ...search for the word "portability" C *** or the word "PORTABILITY" C -- ... -- C Note: {The Vax uses bytes with values from -128 to 127. I therefore C use integers for my calculations, and then output the resulting C values as a byte by calling two routines which buffer the output C up until 512 bytes have been buffered and then writes this 1 record, C resets the buffer count and starts buffering again, and also the C routine recieves the integer value in the range 0 to 255, C then converts the value to the byte value from -128 to 127 and C then buffers the byte value for the write to the file. C The routines GRTX11 does this for the PK file, and GRTX12 does C this for the TFM file. Routines GRTX11 and GRTX12 will definitely C haved to be modified if bytes are read and written as NON-SIGNED C quantities on a different computer.} C Note: {The routine GRTX05 uses an assignment statement SOLBLK='FF'X C to set a parameter to have all ones in its bit positions - C and SOLWHT='00'X to set a parameter to have all zeros in its bit positions-- C this may need to be changed in porting the code to other machines. C The variables BITMAP and BUFFER are byte variables and thus C use non-standard FORTRAN language in setting and comparing C values throughout this driver code. Anywhere that byte variables C are used is a suspect in porting this code to other machines.} C *** I believe that TeX, etc., uses ASCII internally so that C *** the way I have coded the letters will work correctly. C *** However, if porting to other machines, keep in mind that C *** I have hard-coded the character representations as ASCII values C *** specific to a VAX. C *** Note: I wrote most of the comments as I was writing these routines. C *** There had to be some rewrites on some of the routines, C *** such as changing BENCOD from a byte array to an integer C *** array, and rewriting the RUN CODING routine. I tried to C *** go back and modify the comments that C *** I could think of being incorrect. However, I was admittedly C *** pressed for time, and may have missed some of the comments, C *** I did not go back over the source code line for line. C======================================================================= C----------------------------------------------------------------------- C *** NDEV is an integer parameter containing the number of currently C *** supported default device configurations (1, the rest have to be C *** gotten by using logicals (or "environment variables"). C *** LNWFIL is a logical variable which determines whether a C *** a new PK font file and TFM file are to be opened while C *** closing the current PK and TFM files. C *** INIT is a logical variable which is used to set up the initial C *** variables the first time this routine is invoked. INIT is used C *** as a flag, the first time we initialize the variables, the next C *** time we do not. C *** PORTRAIT is a logical array which is used to tell whether the C *** output is to be assumed to be in PORTRAIT mode or LANDSCAPE mode. C *** BITMAP is an integer which is used to hold an address pointing C *** to a dynamically allocated memory array. In later C *** routines, BITMAP is a two dimensional array which contains C *** a bitmap of the current graph. C *** BX is an integer giving the x-direction dimension of the array BITMAP. C *** BY is an integer giving the y-direction dimension of the array BITMAP. C *** DEVICE is an integer pointing to the current default device selected C *** (some of the setup may still be overridden by logicals however). C *** IC is an integer variable containing the color index (1=black,0=white) C *** to be used on calls to GRTX00 to draw dots, lines, or to clear dots,lines. C *** ITMPVR is a temporary integer variable used only intermediately in C *** calculations. C *** GRGMEM is an integer function used to allocate contiguous bytes C *** of memory dynamically at run time. C *** GRFMEM is an integer function used free contiguous bytes of C *** memory back up. C *** LUN is an integer array containing the logical unit numbers of C *** the PK file (LUN(1)) and the TFM file (LUN(2)). C *** NPICT is an integer used to reference the current picture frame C *** being drawn?????. C *** PKOUT is an integer variable containing the count on the C *** number of PK Font files up through the current one, that C *** have (or are) being written. C *** CURCHA is an integer variable containing the ASCII value in C *** base10 for the current character being encoded as a PK C *** Font character. C *** IER is an integer array used to obtain the function return values C *** for the GRGMEM and GRFMEM functions. C *** BC is an integer used to contain the ASCII value for the beginning C *** character of the PK Font. C *** NPKBYT is an integer variable used to keep a running total on C *** the number of bytes written to the PK file. C *** MAXX is a real variable which contains the default maximum C *** horizontal device coordinate. [0,MAXX(DEVICE)] is the allowed C *** default range. C *** MAXY is a real variable which contains the default maximum C *** vertical device coordinate. [0,MAXY(DEVICE)] is the allowed C *** default range. C *** RESOLX is a real variable which contains the default resolution in C *** dots per inch in the horizontal direction. C *** RESOLY is a real variable which contains the default resolution in C *** dots per inch in the vertical direction. C *** XMAX is a real variable which contains the actual chosen maximum C *** horizontal device coordinate (MAXX unless user specifies different). C *** YMAX is a real variable which contains the actual chosen maximum C *** vertical device coordinate (MAXY unless user specifies different). C *** TMPRES is a real variable used only for temporary calculations. C *** TMPMXX is a real variable used only for temporary calculations. C *** TMPMXY is a real variable used only for temporary calculations. C *** DEFNAM is a character variable used to contain the default C *** file name prefix. C *** MODE is a temporary character variable used for checking the C *** values of logical variabels (or "environment variables"). C *** MSG is a temporary character variable used in string operations. C *** PKFILE is a character variable used to contain the PK file name. C *** TFMFIL is a character variable used to contain the TFM file name. C *** DEFPK is a character variable used to contain the default PK C *** file name. C *** TFMDEF is a character variable used to contain the default TFM C *** file name. C *** CTMPST is a temporary character variable used in string operations. C *** BITFIL is a character variable used to contain the BITMAP file C *** name. C *** DEFBIT is a character variable used to contain the default BITMAP C *** file name. C *** CHINFO is an integer array used to contain information about each PK C *** font character. CHINFO is output as part of the TFM file. C *** WIDTH is an integer array used to contain information about each PK C *** font character. WIDTH is a table containing the width of each C *** of the PK font characters. WIDTH is output to the TFM file. C *** HEIGHT is an integer array used to contain information about each PK C *** font character. HEIGHT is a table containing the height of each C *** of the PK font characters. HEIGHT is output to the TFM file. C *** IXBXLL, IYBXLL is the lower left corner of the minimal bounding C *** box of the graphics character (which is found in the RUN CODE routine). C *** IXBXUR, IYBXUR is the upper right corner of the minimal bounding C *** box of the graphics character (which is found in the RUN CODE routine). C *** CHBITD is a character variable used to contain the requested C *** type of BITMAP DUMP if one is requested -- possible values C *** are 'MINIMAL' and 'ALL'. C *** LBUSED is a logical used to determine whether the BITMAP has been C *** written to or not (in case PGPAGE or PGADVANCE are called before C *** actually drawing anything in the BITMAP array). C----------------------------------------------------------------------- C This is the number of currently C installed devices. INTEGER*4 NDEV PARAMETER (NDEV = 1) C LOGICAL LBITFO, LNEWFL, INIT, PORTRAIT(NDEV), LBUSED INTEGER*4 BITMAP, BX,BY,DEVICE,I,J,K,IC,ITMPVR INTEGER*4 PKOUT,CURCHA,JTMP1,JTMP2,NPICT,LUN(2),SS_NORMAL C INTEGER*4 GRFMEM, GRGMEM C INTEGER*4 IER, BC, NPKBYT,IXBXLL,IYBXLL,IXBXUR,IYBXUR REAL*4 MAXX(NDEV),MAXY(NDEV),RESOLX(NDEV),RESOLY(NDEV) REAL*4 XBUF(4), XMAX, YMAX , TMPRES, TMPMXX, TMPMXY CHARACTER DEFNAM*6,MODE*20,MSG*10,CHBITD*7 CHARACTER PKFILE*80,TFMFIL*80,DEFPK*80,DEFTFM*80,CTMPST*80 CHARACTER BITFIL*80,DEFBIT*80,CHTMPS*80 BYTE BYTVAL C *** PARAMETER (DEFNAM = 'PGPLOT') C *** Use lower case instead for unix... PARAMETER (DEFNAM = 'pgplot') PARAMETER (SS_NORMAL = 1) PARAMETER (BC=65) C *** BC could be chosen to be a different value here (and it C *** would be changed throught the TeX PK font driver routines). C *** Note: 0<=BC<256 is required. BC is the beginning ASCII C *** value of the PK font, A=65base10. If you want some other C *** character as first, then change the value of BC. C *** These TeX PK Font driver routines were designed to only C *** have 15 characters per font, but the driver is capable of C *** producing several fonts. The Characters codes reset to C *** begin with BC for each font. INTEGER CHINFO(BC:BC+14,4),WIDTH(0:15,4),HEIGHT(0:15,4),IWHITE PARAMETER(IWHITE='00'X) C Set up initialization for first call. DATA INIT /.TRUE./ C Set the default color to black(=1). DATA IC /1/ C Set the bitmap to not used. DATA LBUSED /.FALSE./ C These are the NDEV sets of C device characteristics. DATA PORTRAIT /.TRUE./ DATA MAXX / 855.0/ DATA MAXY / 855.0/ DATA RESOLX / 300.0/ DATA RESOLY / 300.0/ C----------------------------------------------------------------------- IF (INIT) THEN DEVICE=1 C *** Check the logicals (or "Environment variables") beginning C *** with "PGPLOT_" for overriding the defaults listed above. CALL GRGENV ('TX_XRESOL', MODE, I) READ(UNIT=MODE,FMT=*,ERR=1,END=1) TMPRES IF(TMPRES.LE.0.0 .AND. MODE.NE.' ') 2 CALL GRWARN('PGPLOT_TX_XRESOL ' 3 //'has been defined to be < 0.0 dots per inch. ' 4 //' **** IGNORING and continuing... *** ') IF(TMPRES.GT.0.0) RESOLX(DEVICE)=TMPRES 1 CALL GRGENV ('TX_YRESOL', MODE, I) READ(UNIT=MODE,FMT=*,ERR=2,END=2) TMPRES IF(TMPRES.LE.0.0 .AND. MODE.NE.' ') 2 CALL GRWARN('PGPLOT_TX_YRESOL ' 3 //'has been defined to be <= 0.0 dots per inch. ' 4 //' **** IGNORING and continuing... *** ') IF(TMPRES.GT.0.0) RESOLY(DEVICE)=TMPRES 2 CALL GRGENV ('TX_XINCHES', MODE, I) READ(UNIT=MODE,FMT=*,ERR=3,END=3) TMPMXX IF(TMPMXX.GT.22.0) THEN CALL GRWARN('******-- PGPLOT_TX_XINCHES > 22.0 **** --- ' 2 //' This may not work correctly. The design ' 3 //'size specified in the PGPLOT TX Driver ' 4 //' (TeX PK Font output) allows a range from ' 5 //' a little less than 1/11 of an inch to ' 6 //' a little more thant 22 inches. ' 7 //' You will probably have to modify the ' 8 //'source code in order to produce output ' 9 //'larger than 22 inches. ') ENDIF IF(TMPMXX.LT.1.0/11.0 .AND. TMPMXX.GT.0.0) THEN CALL GRWARN('******-- PGPLOT_TX_XINCHES < 1.0/11.0 **** -' 2 //'-- This may not work correctly. The design ' 3 //'size specified allows a range from ' 4 //' a little less than 1/11 of an inch to a ' 5 //' a little more than 22 inches. ' 6 //' You will probably have to modify the ' 7 //'source code in order to produce output ' 8 //'less than 1/11 inches. ') ENDIF IF(TMPMXX.LE.0.0 .AND. MODE.NE.' ') 2 CALL GRWARN('PGPLOT_TX_XINCHES ' 3 //'has been defined to be <= 0.0 inches ' 4 //' **** IGNORING and continuing... *** ') IF(TMPMXX.GT.0.0) MAXX(DEVICE)=TMPMXX*RESOLX(DEVICE) 3 CALL GRGENV ('TX_YINCHES', MODE, I) READ(UNIT=MODE,FMT=*,ERR=4,END=4) TMPMXY IF(TMPMXY.GT.22.0) THEN CALL GRWARN('******-- PGPLOT_TX_YINCHES > 22.0 **** --- ' 2 //' This may not work correctly. The design ' 3 //'size specified allows a range from ' 4 //' a little less than 1/11 of an inch to a ' 5 //' a little more than 22 inches. ' 6 //' You will probably have to modify the ' 7 //'source code in order to produce output ' 8 //'greater than 22 inches. ') ENDIF IF(TMPMXY.GT.0.0 .AND. TMPMXY.LT.1.0/11.0) THEN CALL GRWARN('******-- PGPLOT_TX_YINCHES < 1.0/11.0 **** -' 2 //'-- This may not work correctly. The design ' 3 //'size specified allows a range from ' 4 //' a little less than 1/11 of an inch to a ' 5 //' a little more than 22 inches. ' 6 //' You will probably have to modify the ' 7 //'source code in order to produce output ' 8 //'less than 1/11 inches. ') ENDIF IF(TMPMXY.LE.0.0 .AND. MODE.NE.' ') 2 CALL GRWARN('PGPLOT_TX_YINCHES ' 3 //'has been defined to be <= 0.0 inches ' 4 //' **** IGNORING and continuing... *** ') IF(TMPMXY.GT.0.0) MAXY(DEVICE)=TMPMXY*RESOLY(DEVICE) 4 CALL GRGENV ('TX_ORIENT', MODE, I) IF(MODE(1:8).EQ.'PORTRAIT') THEN PORTRAIT(DEVICE)=.TRUE. CALL GRWARN('PGPLOT_TX_ORIENT ''''PORTRAIT'''' has ' 2 //'been specified.') ENDIF IF(MODE(1:9).EQ.'LANDSCAPE') THEN PORTRAIT(DEVICE)=.FALSE. CALL GRWARN('PGPLOT_TX_ORIENT ''''LANDSCAPE'''' has ' 2 //'been specified.') ENDIF CALL GRGENV ('TX_BITFILE', MODE, I) LBITFO=.FALSE. CHBITD=' ' IF(MODE(1:7).EQ.'MINIMUM' .OR. MODE(1:3).EQ.'ALL')THEN LBITFO=.TRUE. CHBITD=MODE ENDIF C *** Set INIT to be .FALSE. so that the above checks on C *** environment variables will only occur the first time C *** that TXDRIV is called. INIT = .FALSE. ENDIF C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in TeX PK Font' 1 //' device driver: '// MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE C *** This is the name seen when a "?" is entered by the user for C *** the desired output device for PGPLOT. CHR='TX (TeX PK Font generation)' LCHR=LEN(CHR) NBUF = 0 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE C *** Negative one implies that the physical maximums are unlimited for C *** this device. PGPLOT requires the minimums to be ZERO. RBUF(1) = 0.0 RBUF(2) = -1 RBUF(3) = 0.0 RBUF(4) = -1 RBUF(5) = 0.0 RBUF(6) = 1.0 NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE C *** This give the device resolution in dots per inch in the C *** horizontal and vertical directions. RBUF(1) = RESOLX(DEVICE) RBUF(2) = RESOLY(DEVICE) RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CONTINUE CHR = 'HNNNNNNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE C *** This returns the default prefix for the filenames of TXDRIV. CHR = DEFNAM NBUF = 0 LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE C *** These defaults are in device coordinate values. RBUF(1) = 0.0 RBUF(2) = MAXX(DEVICE) RBUF(3) = 0.0 RBUF(4) = MAXY(DEVICE) NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE C *** Has to do with character fonts that PGPLOT reads in. IF (RESOLX(DEVICE) .GE. 300.0) THEN RBUF(1) = 3.0 ELSE IF (RESOLX(DEVICE) .GE. 150.0) THEN RBUF(1) = 2.0 ELSE RBUF(1) = 1.0 END IF NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C This will be a possible future enhancement to C have several devices open at one time... C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C C C *** Set up the default file name for the TeX PK Font file. ITMPVR=INT(RESOLX(DEVICE)) WRITE(UNIT=MSG,FMT='(I10)') ITMPVR DO 91, I=10,1, -1 IF(MSG(1:1).EQ.' ') THEN MSG(1:1)=MSG(2:2) MSG(2:2)=MSG(3:3) MSG(3:3)=MSG(4:4) MSG(4:4)=MSG(5:5) MSG(5:5)=MSG(6:6) MSG(6:6)=MSG(7:7) MSG(7:7)=MSG(8:8) MSG(8:8)=MSG(9:9) MSG(9:9)=MSG(10:10) ELSE GOTO 92 ENDIF 91 CONTINUE 92 CONTINUE DEFPK=DEFNAM//'.'//MSG(1:I)//'pk' C *** C *** C *** C *** Set up the default file name for the TeX TFM file. DEFTFM=DEFNAM//'.tfm' C *** Set up the default file name for the raw unformatted BITMAP file. DEFBIT=DEFNAM//'.bitmap' C *** C *** C *** Remove the '.' and any remaining characters after the '.' C *** from the file name. We will append the resolution and PK to C *** the PK Font output file, and TFM to the TFM file, and C *** BITMAP to the raw unformatted bitmap file. C C *** Store CHR(1:LCHR) in a temporary string, CTMPST to work with. CTMPST=CHR(1:LCHR) DO 94, K=LCHR,1, -1 C *** Check for ending period on Vax. IF(CTMPST(K:K).EQ.'.') THEN DO 93, J=K,LCHR CTMPST(J:J)=' ' 93 CONTINUE GOTO 95 C *** Check for logical name on Vax. ELSE IF(CTMPST(K:K).EQ.':') THEN GOTO 95 C *** Check for end of directory name on Vax. ELSE IF(CTMPST(K:K).EQ.']') THEN GOTO 95 C *** Check for end of directory name on Unix. ELSE IF(CTMPST(K:K).EQ.'/') THEN GOTO 95 ENDIF 94 CONTINUE 95 CONTINUE C *** C *** Now, find the end of the string. DO 96, K=LCHR,1, -1 IF(CTMPST(K:K).NE.' ') GOTO 97 96 CONTINUE 97 CONTINUE IF(K.GT.0) THEN C *** Set up the requested file names (otherwise, we will set it to the C *** DEFAULT NAMES. PKFILE=CTMPST(1:K)//'.'//MSG(1:I)//'pk' TFMFIL=CTMPST(1:K)//'.tfm' BITFIL=CTMPST(1:K)//'.bitmap' ELSE PKFILE=DEFPK TFMFIL=DEFTFM BITFIL=DEFBIT ENDIF C *** ---------------------------------------------------------- C Obtain a logical unit number C for TeX PK Font file. CALL GRGLUN (LUN(1)) C Check for an error. IF (LUN(1) .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit for PK File.') RBUF(2) = 0 RETURN ELSE C Need to return the logical unit C number of the file. RBUF(1) = LUN(1) END IF C *** C C OPEN the files. C *VMS We will write out 512 bytes at a time. RMS will take C care of us when we read the file back in for DVIing it C If you have problems, change ACCESS='DIRECT' to C ACCESS='SEQUENTIAL' and add RECORDTYPE=FIXED and C modify write statements in GRTX11 and GRTX12 to C be writes to sequential files. Also, consider C using the rewind statement if you do a sequential file. OPEN(UNIT=LUN(1),FILE=PKFILE,ACCESS='DIRECT', 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, 3 DISP='DELETE', 4 RECL=128) C C *** *UNIX Want to open up a file to put "bytes on a disk -- C *** with NO segmented record information... 512 bytes C *** will be written out at a time. 128*4=512 C *** OPEN(UNIT=LUN(1),FILE=PKFILE,ACCESS='DIRECT', C *** 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, C *** 3 RECL=128) C C C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for TeX PK ' 2 //'Font.') RBUF(2) = 0 CALL GRFLUN (LUN(1)) RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN(1), NAME = CHR) LCHR = LEN (CHR) 98 CONTINUE IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 98 END IF END IF C *** Initialize some indirect C *** file pointer information. CALL GRTX14 C *** C C C C Obtain a logical unit number C for TeX TFM file. CALL GRGLUN (LUN(2)) C Check for an error. IF (LUN(2) .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit for TFM file.') CLOSE(UNIT=LUN(1)) CALL GRFLUN (LUN(1)) RBUF(2) = 0 RETURN END IF C IF (LUN(2) .EQ. LUN(1)) THEN CALL GRWARN('ERROR IN PGPLOT LIBRARY GRGLUN FUNCTION. ' 2 //'IDENTICAL UNIT NUMBERS WERE RETURNED TO ' 3 //'TXDRIV ROUTINE.') CALL GRQUIT('EXITING BACK TO OPERATING SYSTEM FROM TXDRIV.') STOP ENDIF C C *VMS We will write out 512 bytes at a time. RMS will take C care of us when we read the file back in for DVIing it C If you have problems, change ACCESS='DIRECT' to C ACCESS='SEQUENTIAL' and add RECORDTYPE=FIXED and C modify write statements in GRTX11 and GRTX12 to C be writes to sequential files. Also, C consider using the rewind statement if you do sequential C files. OPEN(UNIT=LUN(2),FILE=TFMFIL,ACCESS='DIRECT', 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, 3 DISP='DELETE', 4 RECL=128) C C *** *UNIX Want to open up a file to put "bytes on a disk -- C *** with NO segmented record information... 512 bytes C *** will be written out at a time. 128*4=512 C *** OPEN(UNIT=LUN(2),FILE=TFMFIL,ACCESS='DIRECT', C *** 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, C *** 3 RECL=128) C C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN('Cannot open output file for TeX TFM.') RBUF(2) = 0 CLOSE(UNIT=LUN(1)) CALL GRFLUN (LUN(1)) CALL GRFLUN (LUN(2)) RETURN ENDIF C *** Initialize some indirect C *** file pointer information. CALL GRTX15 C *** C C Initialize the plot file. C C *** Set the character number to 1. CURCHA=1 C *** Set the PK Font file to 1. PKOUT=1 C *** Set the number of bytes written to the PK file to 0. NPKBYT=0 C *** Write the preamble to the PK Font file UNIT=LUN(1). CALL GRTX04 (RESOLX,RESOLY,NDEV,DEVICE,LUN,NPKBYT) C *** Set up the TFM file arrays CHINFO, WIDTH, HEIGHT. C *** The CHINFO table will remain as set up. The WIDTH and HEIGHT C *** tables will be modified for each of the PK Font characters C *** as the character is written to the PK file. DO 99, I=0,14 C *** The width table index is in the first byte. CHINFO(BC+I,1)=I+1 C *** The height table index is in the first nybble of the C *** of the second byte, while the depth table index is in the C *** second nybble of the second byte. CHINFO(BC+I,2)=16*(I+1) C *** The italic table index is in the first six bits of the C *** third byte, while the tag index is in the last two bits C *** of the third byte. (Tag=0 means remainder byte 4 is unused). CHINFO(BC+I,3)=0 C *** This is the remainder byte. It is unused for our purposes. CHINFO(BC+I,4)=0 C *** Initialize the width table to zero. The width table will be C *** modified as each character is written to the PK file. WIDTH(I,1)=0 WIDTH(I,2)=0 WIDTH(I,3)=0 WIDTH(I,4)=0 C *** Initialize the height table to zero. The height table will be C *** modified as each character is written to the PK file. HEIGHT(I,1)=0 HEIGHT(I,2)=0 HEIGHT(I,3)=0 HEIGHT(I,4)=0 99 CONTINUE C *** C *** C *** C C Initialize the page counter. NPICT = 0 RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE C Write out the postamble to C the TeX PK file and TeX TFM C file and close the files. C LNEWFL=.FALSE. CALL GRTX03 (LUN,PKFILE,TFMFIL, 2 CURCHA,PKOUT,RESOLX,RESOLY,XMAX,YMAX, 3 NDEV,DEVICE,LNEWFL,NPKBYT,CHINFO, 4 WIDTH,HEIGHT,BC) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Set the bitmap size. XMAX = RBUF(1) YMAX = RBUF(2) C Calculate the dimensions of the C plot BITMAP. IF (PORTRAIT(DEVICE)) THEN BX = INT (XMAX) / 8 + 1 BY = INT (YMAX) + 1 ELSE BX = INT (YMAX) / 8 + 1 BY = INT (XMAX) + 1 END IF C Allocate a 2-D array in memory C for the BITMAP plot by obtaining C BX*BY contiguous bytes of memory. IER = GRGMEM (BX * BY, BITMAP) C Check for error and clean up C if one was found. IF (IER .NE. SS_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate a memory for plot BITMAP.') END IF C Increment the page number. NPICT = NPICT + 1 C start graphics mode. C Zero out the plot BITMAP memory array. BYTVAL='00'X CALL GRTX13 (BX*BY, %VAL(BITMAP),BYTVAL) C Set up BITMAP as not used. LBUSED=.FALSE. RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Apply any needed tranformation. IF (PORTRAIT(DEVICE)) THEN DO 125 I = 1, 4 XBUF(I) = RBUF(I) 125 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) XBUF(3) = RBUF(4) XBUF(4) = XMAX - RBUF(3) END IF C Draw the point into the bitmap. CALL GRTX00 (1, XBUF, IC, BX, BY, %VAL (BITMAP)) C If point "drawn" was not an C erasure (white), then set C BITMAP as having been used. IF(IC.NE.IWHITE) LBUSED=.TRUE. RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Apply any needed tranformation. IF (PORTRAIT(DEVICE)) THEN DO 135 I = 1, 2 XBUF(I) = RBUF(I) 135 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) END IF C Draw the point into the bitmap. CALL GRTX00 (0, XBUF, IC, BX, BY, %VAL(BITMAP)) C If point "drawn" was not an C erasure (white), then set C BITMAP as having been used. IF(IC.NE.IWHITE) LBUSED=.TRUE. RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Need to write out the Font character. C *** Encode the current PK Font character and write it out. C *** ------------------------------------ DO 141, JTMP2=LEN(PKFILE),2,-1 IF(PKFILE(JTMP2:JTMP2).NE.' ') GOTO 142 141 CONTINUE 142 CONTINUE C *** PORTABILITY NOTE: Might want to use JTMP1=ICHAR('A')+CURCHA-1 C *** or something equivalent if on an EBCDIC machine... ? C *** I think (but I'm not sure) that TeX, etcetera, use ASCII internally. C *** I coded this as VaX specific. JTMP1=BC+CURCHA-1 C IF(ICHAR('A').NE.65) CALL GRWARN('Next message is not correct.' C 2 //'it assumes that the ASCII value of A was 65base10.') C C ---------------- C *** *UNIX impossible string concatenation bug workaround. Also works C *** under *VMS . CHTMPS=PKFILE CALL GRWARN('Starting to process the image ' 2 //'to produce the PK Font '''//CHTMPS(1:JTMP2) 3 //''' letter '''//CHAR(JTMP1)//''' from ' 4 //'your BITMAP...') C ----------------- C C *** Test to se if BITMAP has been drawn to (used). IF(.NOT. LBUSED) THEN CALL GRWARN('Blank page was submitted for making ' 2 //'a character out of. -- ignoring this ' 3 //'blank character and continuing.') GOTO 149 ENDIF C ---------------- C *** Time to process the bitmap into a PK Font character. C CALL GRTX02 (BX,BY,%VAL(BITMAP),CURCHA, 2 RESOLX,RESOLY,XMAX,YMAX,NDEV, 3 DEVICE,LUN,NPKBYT,CHINFO, 4 WIDTH,HEIGHT,BC,IXBXLL,IYBXLL,IXBXUR,IYBXUR) C ---------------- C *** PORTABILITY NOTE: Might want to use JTMP1=ICHAR('A')+CURCHA-1 C *** or something equivalent if on an EBCDIC machine... ? C *** I think (but I'm not sure) that TeX, etcetera, use ASCII internally. C *** I coded this as VaX specific. C IF(ICHAR('A').NE.65) CALL GRWARN('Next message is not correct.' C 2 //'it assumes that the ASCII value of A was 65base10.') C C ---------------- C *** Increment the character count. C ---------------- C *** *UNIX impossible string concatenation bug workaround. Also works C *** under *VMS . CHTMPS=PKFILE CALL GRWARN('Finished processing ' 2 //'the PK Font '''//CHTMPS(1:JTMP2) 3 //''' letter '''//CHAR(JTMP1)//''' from ' 4 //'your BITMAP...') C ----------------- CURCHA=CURCHA+1 IF(CURCHA.GE.16) THEN C *** Need to start a new PK Font. We may only have up to C *** 15 characters per Font. LNEWFL=.TRUE. CALL GRTX03 (LUN,PKFILE,TFMFIL, 2 CURCHA,PKOUT,RESOLX,RESOLY,XMAX,YMAX, 3 NDEV,DEVICE,LNEWFL,NPKBYT,CHINFO, 4 WIDTH,HEIGHT,BC) C *** Set the current character to the first one in the Font. CURCHA=1 C *** Increment the number of Fonts produced. PKOUT=PKOUT+1 C *** Reset the TFM arrays CHINFO, WIDTH, HEIGHT for the new Font. C *** The CHINFO table will remain as set up. The WIDTH and HEIGHT C *** tables will be modified for each of the PK Font characters C *** as the character is written to the PK file. DO 143, I=0,14 C *** The width table index is in the first byte. CHINFO(BC+I,1)=I+1 C *** The height table index is in the first nybble of the C *** of the second byte, while the depth table index is in the C *** second nybble of the second byte. CHINFO(BC+I,2)=16*(I+1) C *** The italic table index is in the first six bits of the C *** third byte, while the tag index is in the last two bits C *** of the third byte. (Tag=0 means remainder byte 4 is unused). CHINFO(BC+I,3)=0 C *** This is the remainder byte. It is unused for our purposes. CHINFO(BC+I,4)=0 C *** Initialize the width table to zero. The width table will be C *** modified as each character is written to the PK file. WIDTH(I,1)=0 WIDTH(I,2)=0 WIDTH(I,3)=0 WIDTH(I,4)=0 C *** Initialize the height table to zero. The height table will be C *** modified as each character is written to the PK file. HEIGHT(I,1)=0 HEIGHT(I,2)=0 HEIGHT(I,3)=0 HEIGHT(I,4)=0 143 CONTINUE C *** C *** C *** ENDIF C *** C *** IF(LBITFO.EQ..TRUE.) THEN C *** Dump the bitmap out to a file. CALL GRWARN('Writing out a copy of BITMAP ' 2 //'as you requested by PGPLOT_TX_BITFILE ' 3 //' logical.') CALL GRTX01 (BX, BY, %VAL (BITMAP),BITFIL, 2 CHBITD,IXBXLL,IYBXLL,IXBXUR,IYBXUR, 3 LUN,PKOUT,CURCHA) ENDIF C 149 CONTINUE C Deallocate the memory for the C BITMAP plot array. IER = GRFMEM (BX * BY, BITMAP) C Check for an error. IF (IER .NE. SS_NORMAL) THEN CALL GRGMSG (IER) CALL GRWARN('Failed to deallocate memory for plot BITMAP.') END IF RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) C If out of range set to black. IF (IC .LT. 0 .OR. IC .GT. 1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C (Not implemented: should not be called.) C 190 CONTINUE GOTO 900 C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C (Not implemented: should not be called.) C 200 CONTINUE GOTO 900 C C--- IFUNC = 21, Set color representation. ----------------------------- C (Not implemented: ignored.) C 210 CONTINUE RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C (Not implemented: should not be called.) C 220 CONTINUE GOTO 900 C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C (Not implemented: should not be called.) C 240 CONTINUE GOTO 900 C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C C *GRTX00 -- PGPLOT TeX PK Font Driver, draw line in BITMAP C SUBROUTINE GRTX00 (LINE,RBUF,ICOLOR,IBXDIM, 2 IBYDIM,BITMAP) IMPLICIT NONE INTEGER*4 IBXDIM,IBYDIM,ICOLOR,LINE BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1) REAL*4 RBUF(4) C C Draw a straight line segment from absolute pixel coordinates (RBUF(1), C RBUF(2)) to (RBUF(3), RBUF(4)). The line either overwrites (sets to C black) or erases (sets to white) the previous contents of the bitmap, C depending on the current color index. Setting bits is accomplished C with Non-standard Fortran as .OR.; clearing C bits is accomplished with Non-standard Fortran as .AND. .NOT.. C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R Ending point of line. C ICOLOR I I =0 for erase, =1 for write (black point). C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0 : 7) INTEGER*4 K,KX,KY,LENGTH REAL*4 D,XINC,XP,YINC,YP QMASK(0)='80'X QMASK(1)='40'X QMASK(2)='20'X QMASK(3)='10'X QMASK(4)='08'X QMASK(5)='04'X QMASK(6)='02'X QMASK(7)='01'X C----------------------------------------------------------------------- IF (LINE .GT. 0) THEN D = MAX (ABS (RBUF(3) - RBUF(1)), ABS (RBUF(4) - RBUF(2))) LENGTH = D IF (LENGTH .EQ. 0) THEN XINC = 0.0 YINC = 0.0 ELSE XINC = (RBUF(3) - RBUF(1)) / D YINC = (RBUF(4) - RBUF(2)) / D END IF ELSE LENGTH = 0 XINC = 0.0 YINC = 0.0 END IF C *** Round to nearest integer in device coordinates. XP = RBUF(1) + 0.5 YP = RBUF(2) + 0.5 IF (ICOLOR .NE. 0) THEN DO 100, K = 0, LENGTH KX = XP KY = YP BITMAP(KX/8,KY)=BITMAP(KX/8,KY) .OR. 1 QMASK(MOD (KX, 8)) XP = XP + XINC YP = YP + YINC 100 CONTINUE ELSE DO 200, K=0,LENGTH KX = XP KY = YP BITMAP(KX/8,KY) = BITMAP(KX/8,KY) 1 .AND. (.NOT. QMASK(MOD (KX, 8))) XP = XP + XINC YP = YP + YINC 200 CONTINUE END IF C----------------------------------------------------------------------- RETURN END C C *GRTX01 -- PGPLOT Bitmap File Output driver, copy bitmap to output file C SUBROUTINE GRTX01 (IBXDIM,IBYDIM,BITMAP,BITFIL, 2 CHBITD,IXBXLL,IYBXLL,IXBXUR,IYBXUR, 3 LUN,PKOUT,CURCHA) IMPLICIT NONE INTEGER IBXDIM,IBYDIM,IBTLUN,IRECLB,LUN(2),PKOUT,CURCHA INTEGER IXBXLL,IYBXLL,IXBXUR,IYBXUR BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1) CHARACTER*(*) BITFIL,CHBITD C C Arguments: C C BITLFIL the BITMAP file name (or the default BITMAP file name). C IBXDIM,IBYDIM (input) dimensions of BITMAP C BITMAP (input) the bitmap array C IXBXLL,IYBXLL (input) the pixel numbers of the lower left corner of C the minimal bounding box of the graphics character C IXBXUR,IYBXUR (input) the pixle numbers of the upper right corner of C the minimal bounding box of the graphics character C NOTE: IXBXLL C *GRTX02 -- PGPLOT Encode current PK Font character and store it. C SUBROUTINE GRTX02 (IBXDIM,IBYDIM,BITMAP,CURCHA, 2 RESOLX,RESOLY,XMAX,YMAX,NDEV,DEVICE, 3 LUN,NPKBYT,CHINFO,WIDTH,HEIGHT,BC, 4 IXBXLL,IYBXLL,IXBXUR,IYBXUR) C----------------------------------------------------------------------- C *** IMPLICIT NONE INTEGER IBXDIM,IBYDIM,NDEV,DEVICE,CURCHA,I INTEGER LUN(2),NPKBYT,BC,NC,IRCIND,IRPIND REAL RESOLX(NDEV),RESOLY(NDEV),XMAX,YMAX BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1) INTEGER WIDTH(0:15,4),HEIGHT(0:15,4),CHINFO(BC:BC+14,4) C INTEGER GRFMEM, GRGMEM C INTEGER IRUNCD,IRPEAT,BENCOD,IRCDIM,IRPDIM,IBEDIM INTEGER IXBXLL,IYBXLL,IXBXUR,IYBXUR,IER,SS_NORMAL INTEGER IBOXDX,IBOXDY,IDYNF(0:14),IDYNFO,IDYNFV LOGICAL LIBLAK,LTX05E C *** PARAMETER(SS_NORMAL = 1) SS_NORMAL=1 C *** ------------------------------------------------------------- C *** Get the RUN CODE count values of the BITMAP for later ENCODING. C *** First, we need to allocate an array for containing the C *** run code count values {IRUNCD(IRCDIM))}, and an array C *** for containing the repeat counts {IRPEAT(IRPDIM)}. C *** Instead of guessing that the worst case should be no C *** worse than the image changing every other pixel for C *** run code counts, and then allocating that much virtual memory, C *** we first do all of the RUN-CODE calculations without storing C *** the RUN-CODE results, then we allocate the exact amount of C *** of space required for doing the RUN-CODING and then C *** reenter the GRTX05 routine and store the RUN CODE counts C *** as they are calculated the second time. The logical variable C *** LTX05E is used inside of the GRTX05 routine to determine which C *** pass we are on (LTX05E=.FALSE. for the first pass, and C *** LTX05E=.TRUE. for the second pass). C *** PORTABILITY NOTE: {4 bytes in an integer assumed!. The arrays C *** IRUNCD, IRPEAT and BENCOD are 4 byte integers.} C *** C *** Set the dimension of IRUNCD to be 2 and C *** the dimension of IRPEAT to be 2 initially.(We need to C *** have values for IRUNCD and IRPEAT to be dimensioned inside C *** the GRTX05 routine). IRCDIM=2 IRPDIM=2 C IER = GRGMEM (IRCDIM*4,IRUNCD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Failed to allocate a TeX PK Font IRUNCD ' 2 //' RUN CODE count array the 8 bytes.') END IF C IER = GRGMEM (IRPDIM*4,IRPEAT) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Failed to allocate a TeX PK Font IRPEAT' 2 //' repeat count RUN CODE array 8 bytes.') END IF C *** Call the RUN CODEing routine, GRTX05 to determine the size C *** needed for allocating virtual memory to contain the RUN CODE C *** counts. IRCIND and IRPIND will contain the needed dimension C *** values upon return from routine GRTX05. LTX05E=.FALSE. IRCIND=0 IRPIND=0 CALL GRTX05 (BITMAP,IBXDIM,IBYDIM,%VAL(IRUNCD), 2 IRCDIM,%VAL(IRPEAT),IRPDIM,LIBLAK, 3 IXBXLL,IYBXLL,IXBXUR,IYBXUR, 4 LTX05E,IRCIND,IRPIND) C *** Calculate the width of the minimal bounding box for the character. IBOXDX=IXBXUR-IXBXLL+1 IBOXDY=IYBXUR-IYBXLL+1 C *** Now Deallocate the 8 bytes of Virtual memory contained in C *** the IRCUND and IRPEAT arrays and allocate the amount of C *** virtual memory that we really need for calculating the C *** RUN CODE counts. C IER=GRFMEM (IRPDIM*4,IRPEAT) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('FAILED TO DEALLOCATE IRPEAT ARRAY' 2 //' MEMORY 8 bytes.') ENDIF C IER=GRFMEM (IRCDIM*4,IRUNCD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('FAILED TO DEALLOCATE IRUNCD ARRAY' 2 //' MEMORY 8 bytes.') ENDIF C *** C *** Now allocate the actual virtual memory space that we need. IRCDIM=IRCIND-1 IRPDIM=IRPIND-1 C *** Add test for 0 allocation... IF(IRCDIM.EQ.0) THEN CALL GRQUIT('ERROR in RUN CODING the IMAGE. The size ' 2 //'of the RUN-CODed image is ZERO. Routine GRTX02.') ENDIF C IF(IRPDIM.EQ.0) THEN IRPDIM=1 CALL GRWARN('There were no repeat counts for the ' 2 //'current graphics character.') ENDIF C IER = GRGMEM (IRCDIM*4,IRUNCD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Failed to allocate a TeX PK Font IRUNCD ' 2 //' RUN CODE count array.') END IF C IER = GRGMEM (IRPDIM*4,IRPEAT) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Failed to allocate a TeX PK Font IRPEAT' 2 //' repeat count RUN CODE array.') END IF C *** C *** Now call GRTX05 and calculate -- and this time STORE -- the actual C *** RUN CODE counts. LTX05E=.TRUE. IRCIND=0 IRPIND=0 CALL GRTX05 (BITMAP,IBXDIM,IBYDIM,%VAL(IRUNCD), 2 IRCDIM,%VAL(IRPEAT),IRPDIM,LIBLAK, 3 IXBXLL,IYBXLL,IXBXUR,IYBXUR, 4 LTX05E,IRCIND,IRPIND) C *** C *** C *** ------------------------------------------------------------- C *** Get the dyn_f value for the current RUN CODE counts for C *** optimal encoding. CALL GRWARN('Calculating the optimal dyn_f value ' 2 //'for PK ENCODE-ing the character.') CALL GRTX06(%VAL(IRUNCD),IRCDIM,IBOXDX, 2 IBOXDY,IDYNF,%VAL(IRPEAT), 3 IRPDIM,BITMAP,IBXDIM,IBYDIM) C *** Determine what the optimal dyn_f value is. IDYNFO=14 IDYNFV=IDYNF(14) DO 100, I=0,14 IF(IDYNF(I).LT.IDYNFV) THEN IDYNFO=I IDYNFV=IDYNF(I) ENDIF 100 CONTINUE C *** The optimal value of dyn_f is contained in IDYNFO. C *** The number of nybbles required for encoding is contained in IDYNFV. C *** ------------------------------------------------------------- C *** ENCODE the RUN CODE counts using the optimal dyn_f. C *** First, we need to allocate enough space for the optimal C *** encoding. IDYNFV contains the number of nybbles required. C *** IBEDIM=0 IF(MOD(IDYNFV,2).EQ.1) IBEDIM=1 IBEDIM=IBEDIM+INT(IDYNFV/2) C *** Add a test for Zero allocation... IF(IBEDIM.EQ.0) THEN CALL GRQUIT('ERROR. The specified allocation for ' 2 //'Encoding the RUN-CODE is ZERO 3 // for the BENCOD array in Routine GRTX02.') ENDIF C IER = GRGMEM (IBEDIM*4,BENCOD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('Failed to allocate a TeX PK Font BENCOD' 2 //' ENCODEing array for RUN COUNT.') END IF IF(IDYNFO.EQ.14) THEN CALL GRWARN('PK ENCODE-ing the character using ' 2 //'the optimal dyn_f=14 -- ') CALL GRWARN('which means ' 2 //'''raw compressed bitmapping''...') C *** We should encode using raw compressed bitmapping... CALL GRTX07(BITMAP,IBXDIM,IBYDIM,%VAL(BENCOD), 2 IBEDIM,IXBXLL,IYBXLL,IXBXUR,IYBXUR) ELSE C *** We should encode using the packed number encoding C *** with the optimal value of dyn_f, IDYNFO. CALL GRWARN('PK ENCODE-ing the character using ' 2 //'the optimal dyn_f value...') CALL GRTX08(%VAL(IRUNCD),IRCDIM,IDYNFO, 2 %VAL(IRPEAT),IRPDIM, 3 %VAL(BENCOD),IBEDIM) ENDIF C *** C *** ------------------------------------------------------------- C *** Write out the current PK character. CALL GRWARN('Writing out the current PK character...') NC=CURCHA-1 CALL GRTX09 (IBEDIM,BC,NC,XMAX,RESOLX,NDEV,DEVICE, 2 IXBXLL,IXBXUR,IYBXLL,IYBXUR,IDYNFO, 3 LIBLAK,NPKBYT,LUN,%VAL(BENCOD),HEIGHT, 4 WIDTH,YMAX,RESOLY) C *** ------------------------------------------------------------- C *** Free the memory back up ... C IER=GRFMEM (IBEDIM*4,BENCOD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('FAILED TO DEALLOCATE BENCOD ARRAY MEMORY.') ENDIF C IER=GRFMEM (IRPDIM*4,IRPEAT) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('FAILED TO DEALLOCATE IRPEAT ARRAY MEMORY.') ENDIF C IER=GRFMEM (IRCDIM*4,IRUNCD) IF(IER.NE.SS_NORMAL) THEN CALL GRGMSG(IER) CALL GRQUIT('FAILED TO DEALLOCATE IRUNCD ARRAY MEMORY.') ENDIF C *** C----------------------------------------------------------------------- RETURN END C C *GRTX03 -- PGPLOT Close the current Font, and possibly start new one. C SUBROUTINE GRTX03 (LUN,PKFILE,TFMFIL, 2 CURCHA,PKOUT,RESOLX,RESOLY,XMAX, 3 YMAX,NDEV,DEVICE,LNEWFL,NPKBYT, 4 CHINFO,WIDTH,HEIGHT,BC) C---------------------------------------------------------------------- C *** C *** C *** If LNEWFL=.TRUE. then close the current PK Font and start a C *** new one. IF LNEWFL=.FALSE. then just close the current PK Font C *** file. In either case, write out the Postambles to PK file C *** and to TFM file. IF LNEWFL=.TRUE., then we need to also call C *** GRTX04 to write the Preamble to the new PK file. C *** C *** ------------------------------------------------------------------ C----------------------------------------------------------------------- IMPLICIT NONE INTEGER LUN(2),I,J,NPKBYT,NC,CURCHA,PKOUT,NDEV INTEGER DEVICE,BC,ILENGT,IER INTEGER BYTOUT,CHINFO(BC:BC+14,4),WIDTH(0:15,4) INTEGER HEIGHT(0:15,4),JTMP1,JTMP2 LOGICAL LNEWFL REAL RESOLX(NDEV),RESOLY(NDEV),XMAX,YMAX CHARACTER*(*) PKFILE,TFMFIL CHARACTER MSG*5,CHTMPS*80 C *** ----------------------------------------------------------- C *** Write the postamble to PK file. CALL GRWARN('Writing out the postamble and for the ' 2 //'PK file...') C *** C *** The opcode for the PK postamble is 245 base10. BYTOUT=245 CALL GRTX11(LUN(1),BYTOUT) NPKBYT=NPKBYT+1 C *** Now we need enough no-operation codes to finish filling this block. C *** So, we need to get to a multiple of 512. C *** The preamble required 33 bytes. We have written NPKBYT bytes C *** of character information thus far (includes the preamble C *** and postamble opcode). The postamble requires 1 byte plus enough C *** bytes to finish filling the 512 byte record block on a Vax. C *** We need to have NPKBYT a multiple of 512 after we are finished. C *** We will finish filling the block with no-op's (that is, no-operation C *** opcodes). Note: All the PK format requires is a multiple of 4 (not C *** 512). I chose 512 just to finish filling the current record and block C *** on the Vax. DO 100, I= 1, 512 IF(MOD(NPKBYT,512).EQ.0) GOTO 120 NPKBYT=NPKBYT+1 BYTOUT=246 CALL GRTX11(LUN(1),BYTOUT) 100 CONTINUE 120 CONTINUE C *** Now we are ready to close the PK file. CALL GRWARN('Closing the current PK file...') C *** *VMS CLOSE(UNIT=LUN(1),ERR=130,DISP='KEEP') C *** *UNIX C *** CLOSE(UNIT=LUN(1),ERR=130) C GOTO 140 C *** ---------- 130 CONTINUE CALL GRWARN('ERROR CLOSING PK FILE IN ROUTINE GRTX03') CALL GRQUIT('EXITING BACK TO OPERATING SYSTEM. GRTX03') STOP C *** ------------------------------------------------------- 140 CONTINUE C *** Write the whole TFM file. C *** C *** The number of character which have been stored in the PK Font C *** is given by CURCHA-1. NC=0 is for the first character (ascii C *** code BC. So, NC= (CURCHA-1) -1. NC=CURCHA-2 C *** Routine GRTX10 writes the TFM file. CALL GRWARN('Writing out the TeX Font Metric (TFM) ' 2 //' file...') CALL GRTX10 (NC, LUN(2),CHINFO,WIDTH,HEIGHT,BC) C *** Now we are ready to close the TFM file. CALL GRWARN('Closing the current TFM file...') C C *** *VMS CLOSE(UNIT=LUN(2),ERR=145,DISP='KEEP') C *** *UNIX C *** CLOSE(UNIT=LUN(2),ERR=145) C GOTO 146 C *** ------------ 145 CONTINUE CALL GRWARN('ERROR CLOSING THE TFM FILE.') CALL GRQUIT('EXITING BACK TO OPERATING SYSTEM FROM GRTX03') STOP C *** ------------ 146 CONTINUE DO 150, JTMP2=LEN(PKFILE),2,-1 IF(PKFILE(JTMP2:JTMP2).NE.' ') GOTO 151 150 CONTINUE 151 CONTINUE C *** PORTABILITY NOTE: Might want to use JTMP1=ICHAR('A')+CURCHA-1 C *** or something equivalent if on an EBCDIC machine... ? C *** I think (but I'm not sure) that TeX, etcetera, use ASCII internally. C *** I coded this as VaX specific. JTMP1=BC+CURCHA-2 C IF(ICHAR('A').NE.65) CALL GRWARN('Next message is not correct.' C 2 //'it assumes that the ASCII value of A was 65base10.') C --------------------------- C *** *UNIX impossible string concatenation bug workaround. Also works C *** under *VMS . CHTMPS=PKFILE CALL GRWARN('Finished the PK Font '''//CHTMPS(1:JTMP2) 2 //''' with letter '''//CHAR(JTMP1)//''' . ') C ------------------------- C C *** C *** Now we need to check if we are to open a new PK Font. IF(LNEWFL.EQ..TRUE.) THEN C *** We need to open a new PK Font. C *** C *** We need to determine the new file names for the next font C *** because we are out of space on the current font. WRITE(UNIT=MSG,FMT='(I5)') PKOUT C *** We will used J to keep track of the length of MSG for the C *** two file names below. DO 200, J=5,1,-1 IF(MSG(1:1).EQ.' ') THEN MSG(1:1)=MSG(2:2) MSG(2:2)=MSG(3:3) MSG(3:3)=MSG(4:4) MSG(4:4)=MSG(5:5) MSG(5:5)=' ' ELSE GOTO 201 ENDIF 200 CONTINUE 201 CONTINUE C *** ILENGT=LEN(PKFILE) DO 400, I=ILENGT,1,-1 IF(PKFILE(I:I).EQ.'.') GOTO 401 400 CONTINUE 401 CONTINUE IF(I.GT.0) THEN PKFILE=PKFILE(1:I-1)//'_'//MSG(1:J)//PKFILE(I:ILENGT) ELSE CALL GRWARN('PROGRAMMING ERROR IN PKFILE FILE NAME ' 2 //'IN ROUTINE GRTX03. ERROR WAS MADE ' 3 //'BY AUTHOR OF TXDRIVER ROUTINE.') CALL GRWARN('TRY ANOTHER NAME FOR YOUR FILE NAME.') CALL GRQUIT('EXITING BACK TO OPERATING SYSTEM FROM ' 2 //'ROUTINE GRTX03.') STOP ENDIF C *** ILENGT=LEN(TFMFIL) DO 600, I=ILENGT,1,-1 IF(TFMFIL(I:I).EQ.'.') GOTO 601 600 CONTINUE 601 CONTINUE IF(I.GT.0)THEN TFMFIL=TFMFIL(1:I-1)//'_'//MSG(1:J)//TFMFIL(I:ILENGT) ELSE CALL GRWARN('PROGRAMMING ERROR IN TFMFILE FILE NAME ' 2 //'IN ROUTINE GRTX03. ERROR WAS MADE ' 3 //'BY AUTHOR OF TXDRIVER ROUTINE.') CALL GRWARN('TRY ANOTHER NAME FOR YOUR FILE NAME.') CALL GRQUIT('EXITING BACK TO OPERATING SYSTEM FROM ' 2 //'ROUTINE GRTX03.') STOP ENDIF C *** C *** Finished with Variable J now. Can set it's value to C *** anything. C *** C *** Open the PK file first. CALL GRWARN('Opening a new PK file...') C *VMS We will write out 512 bytes at a time. RMS will take C care of us when we read the file back in for DVIing it C If you have problems, change ACCESS='DIRECT' to C ACCESS='SEQUENTIAL' and add RECORDTYPE=FIXED and C modify write statements in GRTX11 and GRTX12 to C be writes to sequential files. Also, consider C using the rewind statement if you use sequential files. OPEN(UNIT=LUN(1),FILE=PKFILE,ACCESS='DIRECT', 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, 3 DISP='DELETE',RECL=128) C C *** *UNIX Want to open up a file to put "bytes on a disk -- C *** with NO segmented record information... 512 bytes C *** will be written out at a time. 128*4=512 C *** OPEN(UNIT=LUN(1),FILE=PKFILE,ACCESS='DIRECT', C *** 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, C *** 3 RECL=128) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output PK file for new ' 1 //'TeX PK Font.') CALL GRQUIT('Failed to open next Tex PK file.') ENDIF C C *** Initialize some indirect C *** file pointer information. CALL GRTX14 C *** C *** Open the TFM file second. CALL GRWARN('Opening a new TFM file...') C *VMS We will write out 512 bytes at a time. RMS will take C care of us when we read the file back in for DVIing it C If you have problems, change ACCESS='DIRECT' to C ACCESS='SEQUENTIAL' and add RECORDTYPE=FIXED and C modify write statements in GRTX11 and GRTX12 to C be writes to sequential files. Also, consider using C the rewind statement if you use sequential files. OPEN(UNIT=LUN(2),FILE=TFMFIL,ACCESS='DIRECT', 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, 3 DISP='DELETE',RECL=128) C C *** *UNIX Want to open up a file to put "bytes on a disk -- C *** with NO segmented record information... 512 bytes C *** will be written out at a time. 128*4=512 C *** OPEN(UNIT=LUN(2),FILE=TFMFIL,ACCESS='DIRECT', C *** 2 FORM='UNFORMATTED',STATUS='NEW',IOSTAT=IER, C *** 3 RECL=128) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output TFM file for new ' 1 //'TeX PK Font.') CALL GRQUIT('Failed to open next Tex TFM file.') ENDIF C *** Initialize some indirect C *** file pointer information. CALL GRTX15 C *** C *** C C *** C *** We need to write the preamble to the PK file. CALL GRTX04 (RESOLX,RESOLY,NDEV,DEVICE,LUN,NPKBYT) ENDIF C *** Finished. We can return now. C----------------------------------------------------------------------- RETURN END C C *GRTX04 -- PGPLOT Write the preamble for PK file. C SUBROUTINE GRTX04 (RESOLX,RESOLY,NDEV,DEVICE, 2 LUN,NPKBYT) C----------------------------------------------------------------------- C *** GRTX04 IMPLICIT NONE INTEGER BYTOUT INTEGER VM1,VM2,VM3,VM4,VP0,VP1,VP2,VP3,NPKBYT INTEGER LUN(2),NDEV,DEVICE REAL RVPPP,RHPPP,RESOLX(NDEV),RESOLY(NDEV) DOUBLE PRECISION VALUE C *** Write the preamble opcode. BYTOUT=247 CALL GRTX11(LUN(1),BYTOUT) C *** Write out the identification byte of the file. BYTOUT=89 CALL GRTX11(LUN(1),BYTOUT) C *** Write out the comment of where this file came from. C *** The string will be "PGPLOT PK Font",which has ASCII Hex values of C *** "P"=50,"G"=47,"P"=50,"L"=4C,"O"=4F,"T"=54," "=20, C *** "P"=50,"K"=4B," "=20,"F"=46,"o"=6f,"n"=6E,"t"=74 C *** This requires 14 bytes. BYTOUT=14 CALL GRTX11(LUN(1),BYTOUT) C *** Now the string... BYTOUT = 5*16 + 0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 4*16 + 7 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 5*16 + 0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 4*16 + 12 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 4*16 + 15 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 5*16 + 4 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 2*16 + 0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 5*16 + 0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 4*16 + 11 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 2*16 + 0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 4*16 + 6 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 6*16 + 15 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 6*16 + 14 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 7*16 + 4 CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** Now write out the design size of the file in 1/20 points (a Fix_word). C *** This is to be in 4 bytes. The implied decimal is between byte C *** 19 and 20 (0 is the first byte). This is encoded as coefficients C *** of the power of 16. See PKtoPX.Web, or other WEB files for C *** the documentation of this. C *** The design size is 100.0 Tex Points, which is 06400000 as a Fix_word, C *** 100.0base10=6*16+4 base10=64.0base16 =06400000 Fix_word. 100.0 TeX C *** points is approximately 1.3837 inches. (This will allow output C *** characters from 0.0864813 inches to 22.1382 inches in size.) C *** This value should be changed if a different range is desired. BYTOUT=6 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=4*16 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=0 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Now, write out the 4 byte checksum, which must be the same in the C *** TFM file and the PK file. I chose my birthdate 09 28 1963 as the C *** Hex value. BYTOUT = 0*16 + 9 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 2*16 + 8 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 1*16 + 9 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = 6*16 + 3 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Now, write out the 4 byte horizontal ratio of pixels per TeX point, C *** (this is a measure of the dots per inch). The variable RESOLX(DEVICE) C *** contains the dots per inch value. There are horizontally: C *** RESOLX(DEVICE) {pixels/inch}, 2.54 {cm./inch}, C *** 7227.0/254.0 {TeX points/cm.}. So the base10 value of pixels/TeX point is: RHPPP=RESOLX(DEVICE)/2.54*254.0/7227 C *** Now, I must convert this into its base 16 value to place the value C *** multiplied by 2**16 into the 4 bytes. VALUE=RHPPP VP3=INT(VALUE/(16.0**3)) VALUE=VALUE-VP3*16.0**3 VP2=INT(VALUE/(16.0**2)) VALUE=VALUE-VP2*16.0**2 VP1=INT(VALUE/(16.0**1)) VALUE=VALUE-VP1*16.0**1 VP0=INT(VALUE) VALUE=VALUE-VP0 VM1=INT(VALUE/(16.0**(-1))) VALUE=VALUE-VM1*16.0**(-1) VM2=INT(VALUE/(16.0**(-2))) VALUE=VALUE-VM2*16.0**(-2) VM3=INT(VALUE/(16.0**(-3))) VALUE=VALUE-VM3*16.0**(-3) VM4=INT(VALUE/(16.0**(-4))) C *** BYTOUT = VP3*16 + VP2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VP1*16 + VP0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VM1*16 + VM2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VM3*16 + VM4 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Now, write out the 4 byte vertical ratio of pixels per TeX point, C *** (this is a measure of the dots per inch). The variable RESOLY(DEVICE) C *** contains the dots per inch value. There are vertically: C *** RESOLY(DEVICE) {pixels/inch}, 2.54 {cm./inch}, C *** 7227.0/254.0 {TeX points/cm.}. So the base10 value of pixels/TeX point is: RVPPP=RESOLY(DEVICE)/2.54*254.0/7227 C *** Now, I must convert this into its base 16 value to place the value C *** multiplied by 2**16 into the 4 bytes. VALUE=RVPPP VP3=INT(VALUE/(16.0**3)) VALUE=VALUE-VP3*16.0**3 VP2=INT(VALUE/(16.0**2)) VALUE=VALUE-VP2*16.0**2 VP1=INT(VALUE/(16.0**1)) VALUE=VALUE-VP1*16.0**1 VP0=INT(VALUE) VALUE=VALUE-VP0 VM1=INT(VALUE/(16.0**(-1))) VALUE=VALUE-VM1*16.0**(-1) VM2=INT(VALUE/(16.0**(-2))) VALUE=VALUE-VM2*16.0**(-2) VM3=INT(VALUE/(16.0**(-3))) VALUE=VALUE-VM3*16.0**(-3) VM4=INT(VALUE/(16.0**(-4))) C *** BYTOUT = VP3*16 + VP2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VP1*16 + VP0 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VM1*16 + VM2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT = VM3*16 + VM4 CALL GRTX11(LUN(1),BYTOUT) C *** C *** There were 33 bytes written to the Preamble for the PK Font. NPKBYT=33 C *** C *** And that finishes the Preamble for the PK font. C----------------------------------------------------------------------- RETURN END C C *GRTX05 -- PGPLOT Calculate RUN CODE count for PK Font character. C SUBROUTINE GRTX05( BITMAP, IBXDIM, IBYDIM, 2 IRUNCD, IRCDIM, IRPEAT, 3 IRPDIM, LIBLAK, IXBXLL, 4 IYBXLL, IXBXUR, IYBXUR, 5 LTX05E,IRCIND,IRPIND) C----------------------------------------------------------------------- C *** C *** -------------------------------------------------------------- C *** This routine is used to produce RUN CODE for the character C *** contained in the 2-dimensional byte array BITMAP. C *** The algorithm is described in PKtoPX.WEB. The PK Font format C *** was written by Tomas Rokicki in August of 1985. Rokicki was a C *** former Texas A&M student. TeX uses this PK font C *** format for technical typesetting. To get the documentation, C *** WEAVE the PKTOPX.WEB file. TeX the resulting PKTOPX.TEX file. C *** Then run the DVI translator to produce the binary file for C *** printing out to your desired printer. C *** C *** BITMAP is a BYTE input array of size IBXDIM x IBYDIM. C *** IRUNCD is an integer output array of size IRCDIM which will C *** contain the RUN CODE for the character. C *** IRPEAT is an integer output array of size IRPDIM which is used C *** to index the Repeat Counts within the IRUNCD array. C *** The logical variable LTX05E is used to indicate whether this is C *** the first or second invokation of the routine GRTX05. C *** The first invokation calculates the minimum bounding box of the C *** graphics character. C *** IRCIND and IRPEAT are used in the first invokation of routine GRTX05 C *** to return the dimensions of IRUNCD and IRPEAT needed to C *** store the RUN CODE counts. C *** On the second invokation of routine GRTX05, IRCIND and IRPIND are C *** just used for indexing into the IRUNCD and IRPEAT arrays for C *** storing RUN CODE information. C *** C *** C *** --------------------------------------------------------------- C *** IMPLICIT NONE INTEGER IBXDIM,IBYDIM,IRCDIM,IRPDIM, 2 IRUNCD(IRCDIM), IRPEAT(IRPDIM), IRCIND, IRPIND, 3 ICOL, IROW, ITMPRO, ITMPCO, IRPCNT, IRCSUM, 4 IXBXLL, IYBXLL, IXBXUR, IYBXUR, I, J, K INTEGER WHITE,IPERCR,IPERCL,IXBBLL,IXBBUR BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1),SOLBLK,SOLWHT LOGICAL LSOLID,LBLACK,LIBLAK,LTX05E CHARACTER*3 MSG C *** PORTABILITY NOTES: C *** Note: {Vax byte variables are from -128 to 127. C *** ??Parameter statement might need to be modified for SOLBLK=255 C *** base10=FFbase16. C *** Assumption is that SOLBLK will be converted correctly by the compiler C *** to the signed quantity on the vax. I definitely want the C *** result to be all ones in the bit positions. The parameter SOLWHT C *** is to have all zeros in the bit positions.} C *** PARAMETER (WHITE=0, SOLBLK='FF'X,SOLWHT='00'X) WHITE=0 SOLBLK='FF'X SOLWHT='00'X C *** C *** C *** IRCIND is an integer used as an index into the IRUNCD array. C *** IRPIND is an integer used as an index into the IRPEAT array. C *** ICOL is an integer used to keep up with the current X (column) position C *** within the BITMAP array. C *** IROW is an integer used to keep up with the current Y (row) position C *** within the BITMAP array. C *** ITMPRO is an integer used to keep up with the temporary X (column) C *** position within the BITMAP array. C *** ITMPCO is an integer used to keep up with the temporary Y (row) C *** position within the BITMAP array. C *** IRPCNT is an integer used to keep up with the Repeat Count of the C *** consecutive rows within the BITMAP array (that is, identical C *** consecutive rows). C *** IRCSUM is an integer used to keep up a running sum of the number of C *** consecutive pixels which are of the same color C *** (only black and white colors are allowed --- no shades). C *** IXBXLL is an integer used to contain the Lower Left X coordinate C *** of the minimum bounding box of the character (so that all black C *** pixels are just contained within the box). C *** IYBXLL is an integer used to contain the Lower Left Y coordinate C *** of the minimum bounding box of the character (so that all black C *** pixels are just contained within the box). C *** IXBXUR is an integer used to contain the Upper Right X coordinate C *** of the minimum bounding box of the character (so that all black C *** pixels are just contained within the box). C *** IYBXUR is an integer used to contain the Upper Right Y coordinate C *** of the minimum bounding box of the character (so that all black C *** pixels are just contained within the box). C *** I,J, K are temporary variables used for counting and DO Loop indices. C *** LSOLID is a logical variable used to denote that the row in C *** question is a Solid color (either solid white, or solid black). C *** I used LSOLID as an aid in debugging. It is not very useful otherwise. C *** LBLACK is a logical variable used to contain the current pixel color C *** (.TRUE. represents black, while .FALSE. represents white). C *** LIBLAK is a logical variable used to contain the first pixel color C *** of the miniumum bounded box, which is needed later in an upper routine. C *** C *** --------------------------------------------------------------- C *** --------------------------------------------------------------- C *** C *** C *** C *** C *** C *** IF(LTX05E.EQ..FALSE.) THEN CALL GRWARN('There will be 3 passes (scans) over the ' 2 //'graphics character...') C *** Find the minimum bounding box for the character. C *** PGPLOT assumes that lower left corner of character is (0,0). C *** IXBXLL,IXBXUR,IYBXLL,IYBXUR are in PGPLOT coordinates C *** in which (0,0) is lower left. CALL GRWARN('Starting scan number 1 --- Finding the minimal ' 2 //'bounding box around the graphics character.') C *** Initialize the last written percentage of the image remaining to be C *** scanned to be 100%. IPERCL=100 C *** Set up initial bounds for box to be outisde the bitmap area... C *** loop below will override these. IXBBUR=-1 IXBXUR=-1 IYBXUR=-1 IXBBLL=(IBXDIM-1) + 1 IXBXLL=(IBXDIM*8-1) + 1 IYBXLL=(IBYDIM-1) + 1 CALL GRWARN('Percentage of image scan remaining:') CALL GRWARN(' 100% scan remaining ') DO 100, J=IBYDIM-1,0,-1 DO 90, I=0, IBXDIM-1 C *** Write out a message about what percentage of the image remains C *** to be processed. IPERCR=INT(FLOAT(J)/FLOAT(IBYDIM-1)*100.0) IF (IPERCR.LT.(IPERCL-15)) THEN IPERCL=IPERCR WRITE(UNIT=MSG,FMT='(I3)') IPERCL CALL GRWARN(' '//MSG(1:3)//'% scan remaining ') ENDIF C *** C *** IF(BITMAP(I,J).NE.SOLWHT) THEN C *** We have a black pixel somewhere in that byte. IF(I.LE.IXBBLL) THEN IXBBLL = I DO 50, K= IXBBLL*8,IXBBLL*8+7 IF(((BITMAP(K/8,J).AND.2**(7-MOD(K,8))).NE.WHITE) 2 .AND.(K.LE.IXBXLL)) IXBXLL=K 50 CONTINUE ENDIF IF(I.GE.IXBBUR) THEN IXBBUR = I DO 80, K=IXBBUR*8,IXBBUR*8+7 IF(((BITMAP(K/8,J).AND.2**(7-MOD(K,8))).NE.WHITE) 2 .AND.(K.GE.IXBXUR)) IXBXUR=K 80 CONTINUE ENDIF IF(J.LE.IYBXLL) IYBXLL = J IF(J.GE.IYBXUR) IYBXUR = J ENDIF 90 CONTINUE 100 CONTINUE C *** C *** Minimum bounding box has been found to be Lower_Left=(IXBXLL,IYBXLL) C *** Upper_Right=(IXBXUR,IYBXUR). So, 0<=IXBXLL<=IXBXUR<=(IBXDIM-1)*8 C *** and 0<=IYBXLL<=IYBXUR<=(IBYDIM-1). C *** C *** Add error checking... IF(IXBXUR.EQ.-1) CALL GRQUIT('ERROR FINDING MINIMAL BOUNDING' 2 //'BOX AROUND CHARACHTER. THE IMAGE WAS OF SOLID' 3 //'COLOR WHITE. ROUTINE GRTX05.') IF(IYBXUR.EQ.-1) CALL GRQUIT('ERROR FINDING MINIMAL BOUNDING' 2 //'BOX AROUND CHARACHTER. THE IMAGE WAS OF SOLID' 3 //'COLOR WHITE. ROUTINE GRTX05.') IF(IXBXLL.EQ.(IBXDIM*8-1) + 1) CALL GRQUIT('ERROR FINDING ' 2 //'MINIMAL BOUNDING BOX AROUND CHARACHTER. ' 3 //'THE IMAGE WAS OF SOLID COLOR WHITE. ' 4 //'ROUTINE GRTX05.') IF(IYBXLL.EQ.(IBYDIM-1) + 1) CALL GRQUIT('ERROR FINDING ' 2 //'MINIMAL BOUNDING BOX AROUND CHARACHTER. ' 3 //'THE IMAGE WAS OF SOLID COLOR WHITE. ' 4 //'ROUTINE GRTX05.') IF(IXBXLL.GT.IXBXUR) CALL GRQUIT('ERROR IN MINIMAL BOUNDING ' 2 //'BOX CALCULATIONS. Lower row bounds exceeds ' 3 //'upper row bounds. Routine GRTX05.') IF(IYBXLL.GT.IYBXUR) CALL GRQUIT('ERROR IN MINIMAL BOUNDING ' 2 //'BOX CALCULATIONS. Lower column bounds exceeds ' 3 //'upper column bounds. Routine GRTX05.') IF(IXBXLL.EQ.IXBXUR) CALL GRWARN('Lower bounds = Upper bounds ' 2 //'for minimal bounding box of character. ' 3 //' Routine GRTX05.') IF(IYBXLL.EQ.IYBXUR) CALL GRWARN('Lower bounds = Upper bounds ' 2 //'for minimal bounding box of character. ' 3 //' Routine GRTX05.') ENDIF C *** ------------------------------------------------------------------ C *** ------------------------------------------------------------------ C *** IF(LTX05E.EQ..FALSE.) THEN CALL GRWARN ('Minimal bounding box completed.') CALL GRWARN ('Starting scan number 2 -- determining ' 2 //'the amount of virtual memory needed for ' 3 //'RUN CODING the graphics character.') ELSE CALL GRWARN ('Starting scan number 3 -- calculating ' 2 //'and storing RUN CODE counts for later encoding.') C *** Initialize the first repeat count index to be zero in case there C *** are not repeated non-solid rows in the graphics character. C *** Note: IRPEAT must be dimensioned at least 1 in the calling routine. IRPEAT(1)=0 ENDIF C *** C *** Set up the arrays to be indexed into their first element IRCIND=1 IRPIND=1 C *** Set up the current position as the Upper Left corner of the C *** minimum bounding box. ICOL=IXBXLL IROW=IYBXUR C *** Set up the temporary position as the current position. ITMPRO=IROW ITMPCO=ICOL C *** Initialize the Repeat count as 0 and the Run Code sum as 0. IRPCNT=0 IRCSUM=0 C *** Set up the logical variables as all .FALSE. LSOLID=.FALSE. LBLACK=.FALSE. LIBLAK=.FALSE. C *** Initialize the last written percentage of the image remaining to be C *** scanned to be 100%. IPERCL=100 C *** C *** C *** ----------------------------------------------------------------- C *** C *** Determine what the color the initial pixel value is. IF((BITMAP(ICOL/8,IROW).AND.2**(7-MOD(ICOL,8))).NE.WHITE)THEN LBLACK=.TRUE. LIBLAK=.TRUE. ELSE LBLACK=.FALSE. LIBLAK=.FALSE. ENDIF CALL GRWARN('Percentage of image scan remaining:') CALL GRWARN(' 100% remaining ') C *** C *** C *** ------------------------------------------------------------------ C *** BEGINNING_OF_ROW: C *** 2000 CONTINUE C *** C *** C *** C *** Write out a message about what percentage of the image remains C *** to be processed. IPERCR=INT(FLOAT(IROW-IYBXLL+1)/FLOAT(IYBXUR-IYBXLL+1)*100.0) IF (IPERCR.LT.(IPERCL-15)) THEN IPERCL=IPERCR WRITE(UNIT=MSG,FMT='(I3)') IPERCL CALL GRWARN(' '//MSG(1:3)//'% remaining ') ENDIF C *** C *** C *** Let us check and see if the row is a solid of the current color. C *** We will check the "leftover" bits on the left and right of the C *** character first, then if they pass, we will check the bytes in between. C *** Initialize LSOLID=.FALSE. so that "jump_out" to label 6000 will C *** be correct if we do not have a solid row. LSOLID=.FALSE. ITMPRO=IROW ITMPCO=IXBXLL-1 2200 ITMPCO=ITMPCO+1 C *** If we are on an a byte boundary, we have finished checking the C *** left "leftover" bits. Go check the right "leftover" bits. IF(MOD(ITMPCO,8).EQ.0) GOTO 2210 C *** See if the current pixel is the correct color for solid color row. IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) THEN GOTO 2200 ELSE GOTO 6000 ENDIF ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) THEN GOTO 2200 ELSE GOTO 6000 ENDIF ENDIF C *** C *** C *** 2210 CONTINUE C *** C *** Checking the right "leftover" bits now for solid color row. J=IROW I=IXBXUR+1 2220 I=I-1 C *** If we are on an a byte boundary, we have finished checking the C *** right "leftover" bits. Go check the bytes in between. IF(MOD(I,8).EQ.7) GOTO 2240 C *** See if the current pixel is the correct color for solid color row. IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(I/8,J).AND.2**(7-MOD(I,8))) 2 .NE.WHITE) THEN GOTO 2220 ELSE GOTO 6000 ENDIF ELSE IF((BITMAP(I/8,J).AND.2**(7-MOD(I,8))) 2 .EQ.WHITE) THEN GOTO 2220 ELSE GOTO 6000 ENDIF ENDIF C *** C *** C *** C *** C *** 2240 CONTINUE C *** C *** Both the left and right "leftover" bits checked out to be solid C *** color of the current color type. Now need to check the C *** bytes in between to see if they are also solid color of the C *** current type. DO 2250, K=ITMPCO,I,8 IF(LBLACK.EQ..TRUE.) THEN IF(BITMAP(K/8,J).NE.SOLBLK) GOTO 6000 ELSE IF(BITMAP(K/8,J).NE.SOLWHT) GOTO 6000 ENDIF 2250 CONTINUE C *** C *** We have a row which is of solid color. LSOLID=.TRUE. C *** C *** C *** C *** C *** C *** --------------------------------------------------------------- C *** C *** C *** Calculate the # of consecutive rows which are repeats of the current C *** row. Set IRPCNT=#repeated_consecutive_rows. C *** IRPCNT=0 2400 J=IROW-IRPCNT-1 C *** Need to make sure that we do not go out of the bounding box. IF(J.LT.IYBXLL) GOTO 8000 C *** Do a loop comparing the bytes across two rows. Since the bits C *** outside of the minimum bounding box are white (0), we do not C *** have to worry about them -- they will compare okay. C *** There are 8 bits to a byte, so there are 8 pixels to a byte. C *** We can step by 8 pixels to do our check. DO 2420, I=IXBXLL, IXBXUR, 8 IF(BITMAP(I/8,IROW).NE.BITMAP(I/8,J)) GOTO 2450 2420 CONTINUE C *** We have found another repeated consecutive row. IRPCNT=IRPCNT+1 C *** Go back and check if the next row down is also a repeated row. GOTO 2400 C *** C *** C *** C *** 2450 CONTINUE C *** We have found all of the consecutive repeated rows. C *** C *** ------------------------------------------------------------------ C *** C *** Need to determine whether a transition occurs at the first C *** pixel of the first non-repeated solid row. ITMPRO=IROW-IRPCNT-1 ITMPCO=IXBXLL IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 2800 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 2800 ENDIF C *** C *** ---------------------------------------------------------------- C *** 2500 CONTINUE C *** C *** C *** We now have a solid (possibly repeated) row for which the C *** first non-solid row has a transition at the first pixel of C *** the minimum bounded box. C *** C *** Get the sum of the solid row pixels including the repeated solid C *** row pixels. IRCSUM=IRCSUM+(IXBXUR-IXBXLL+1)*(1+IRPCNT) C *** C *** Store this sum for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** C *** Update the current position. IROW=IROW-IRPCNT-1 ICOL=IXBXLL C *** C *** Change current color. LBLACK=.NOT.LBLACK C *** C *** Reset the counters. IRCSUM=0 IRPCNT=0 C *** C *** We are now at the beginning of a new row. GOTO BEGINING_OF_ROW. GOTO 2000 C *** C *** ----------------------------------------------------------------- C *** 2800 CONTINUE C *** C *** C *** We have a solid (possibly with repeat solid rows), which C *** does not have a transition at the first non-solid row C *** first pixel of the minimum bounding box. C *** C *** Get the sum of the pixels for the solid and solid repeated rows. IRCSUM=IRCSUM+(IXBXUR-IXBXLL+1)*(1+IRPCNT) C *** C *** Update the position to the beginning of the first non-solid row. IROW=IROW-IRPCNT-1 ICOL=IXBXLL C *** Find the transition point, (ITMPRO,ITMPCO). ITMPRO=IROW DO 2810, ITMPCO=IXBXLL+1,IXBXUR IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 2820 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 2820 ENDIF 2810 CONTINUE C *** 2820 CONTINUE C *** We now have ITMPRO, ITMPCO where the transition occurs. C *** Add the number of pixels on the current row until the transition C *** occurs to the previous calculated value for the solid (possibly C *** repeated) rows. IRCSUM=IRCSUM+(ITMPCO-ICOL) C *** Store this run code sum. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the current position to be the point of transition. IROW=ITMPRO ICOL=ITMPCO C *** Change the current color. LBLACK=.NOT.LBLACK C *** Reset the counters. IRPCNT=0 IRCSUM=0 C *** C *** C *** -------------------------------------------------------------- C *** 3000 CONTINUE C *** C *** MIDDLE_REPEAT: C *** C *** We are now in the middle of a new row. There may or may not C *** be repeated consecutive rows below the current one. C *** Also, the remaining part of the current row may be solid. C *** C *** --------------------------------------------------------------- C *** C *** Write out a message about what percentage of the image remains C *** to be processed. IPERCR=INT(FLOAT(IROW-IYBXLL+1)/FLOAT(IYBXUR-IYBXLL+1)*100.0) IF (IPERCR.LT.(IPERCL-15)) THEN IPERCL=IPERCR WRITE(UNIT=MSG,FMT='(I3)') IPERCL CALL GRWARN(' '//MSG(1:3)//'% remaining ') ENDIF C *** C *** C *** --------------------------------------------------------------- C *** C *** Calculate the # of consecutive rows which are repeats of the current C *** row. Set IRPCNT=#repeated_consecutive_rows. C *** IRPCNT=0 3100 J=IROW-IRPCNT-1 C *** Need to make sure that we do not go out of the bounding box. IF(J.LT.IYBXLL) GOTO 3200 C *** Do a loop comparing the bytes across two rows. Since the bits C *** outside of the minimum bounding box are white (0), we do not C *** have to worry about them -- they will compare okay. C *** There are 8 bits to a byte, so there are 8 pixels to a byte. C *** We can step by 8 pixels to do our check. DO 3120, I=IXBXLL, IXBXUR, 8 IF(BITMAP(I/8,IROW).NE.BITMAP(I/8,J)) GOTO 3150 3120 CONTINUE C *** We have found another repeated consecutive row. IRPCNT=IRPCNT+1 C *** Go back and check if the next row down is also a repeated row. GOTO 3100 C *** C *** C *** C *** 3150 CONTINUE C *** We have found all of the consecutive repeated rows. C *** C *** ------------------------------------------------------------------ C *** 3200 CONTINUE C *** IF(IRPCNT.GT.0) THEN C *** Store the repeat count for later Encoding. IF(LTX05E.EQ..TRUE.) IRPEAT(IRPIND)=IRCIND IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRPCNT IRPIND=IRPIND+1 IRCIND=IRCIND+1 C *** Update the current position to be the the row of the last C *** repeat count, and remain in the same column. IROW=IROW-IRPCNT ENDIF C *** C *** C *** -------------------------------------------------------------------- C *** 4000 CONTINUE C *** C *** MIDDLE_NO_REPEAT: C *** C *** C *** We are now located in the middle of a row, for which there C *** are definitely not any repeated rows immediately below. C *** There may, however, be that the remainder of the row is solid. C *** C *** C *** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C *** Check for a transition on the current row. C *** C *** Find the transition point, (ITMPRO,ITMPCO). ITMPRO=IROW DO 4110, ITMPCO=ICOL,IXBXUR IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 4120 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 4120 ENDIF 4110 CONTINUE C *** We did not have a transition on the current row. C *** Goto NO_TRANS_CURRENT_ROW. GOTO 4500 C *** 4120 CONTINUE C *** We did have a transition on the current row. C *** C *** Calculate the sum of pixels up to the transition. IRCSUM=IRCSUM+(ITMPCO-ICOL) C *** Store out the resulting pixel RUN CODE sum count. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the current position to be the point of transition. IROW=ITMPRO ICOL=ITMPCO C *** Change the current color. LBLACK=.NOT.LBLACK C *** Reset the counters. IRPCNT=0 IRCSUM=0 C *** C *** We are still in the middle of a row, for which there is no C *** repeat count, and for which the remainder of the row may C *** be of solid color. GOTO MIDDLE_NO_REPEAT. GOTO 4000 C *** C *** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C *** 4500 CONTINUE C *** C *** C *** We are now in the middle of a row for which C *** there are no repeat counts, but the remainder of the row C *** is of solid color. C *** C *** Need check if we are on the last row of the minimal bounding C *** box for the character. IF(IROW.EQ.IYBXLL) GOTO 8100 C *** C *** Need to check for a transition at the first pixel of the C *** next row of the minimal bounding box of the character. ITMPRO=IROW-1 ITMPCO=IXBXLL IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 4700 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 4700 ENDIF C *** C *** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C *** C *** We are on the middle of a row for which there are no C *** repeated rows immediately following, and for which the C *** remainder of the row is of solid color and for which C *** the first pixel on the next row of the minimal bounding C *** box of the character changes color (a transition occurs). C *** C *** Need to calculate the remaining pixels out to the end of the C *** current row. IRCSUM=IRCSUM+(IXBXUR-ICOL+1) C *** Store this for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the current position to be the first pixel on the next line. ICOL=IXBXLL IROW=IROW-1 C *** Change colors. LBLACK=.NOT.LBLACK C *** Reset the counters. IRCSUM=0 IRPCNT=0 C *** C *** We are now at the beginning of a new row. C *** GOTO BEGINNING_OF_ROW. GOTO 2000 C *** C *** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C *** 4700 CONTINUE C *** C *** We are now in the middle of a row for which there are definitely C *** no repeated rows immediately following, and for which the C *** remainder of the row is of solid color, and for which the first C *** pixel of the next row of the minimal bounding box for the C *** character does not change color (no transition). C *** C *** Add up the pixels remaining on the end of the current row. IRCSUM=IRCSUM+(IXBXUR-ICOL+1) C *** Update the current position to be the first pixel on the C *** next row. IROW=IROW-1 ICOL=IXBXLL C *** C *** C *** ---------------------------------------------------------- C *** C *** Need to check and see if the current row is of solid color C *** or not. C *** We will check the "leftover" bits on the left and right of the C *** character first, then if they pass, we will check the bytes in between. C *** Initialize LSOLID=.FALSE. so that "jump_out" to label 5000 will C *** be correct if we do not have a solid row. LSOLID=.FALSE. ITMPRO=IROW ITMPCO=IXBXLL-1 4705 ITMPCO=ITMPCO+1 C *** If we are on an a byte boundary, we have finished checking the C *** left "leftover" bits. Go check the right "leftover" bits. IF(MOD(ITMPCO,8).EQ.0) GOTO 4710 C *** See if the current pixel is the correct color for solid color row. IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) THEN GOTO 4705 ELSE GOTO 5000 ENDIF ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) THEN GOTO 4705 ELSE GOTO 5000 ENDIF ENDIF C *** C *** C *** 4710 CONTINUE C *** C *** Checking the right "leftover" bits now for solid color row. J=IROW I=IXBXUR+1 4720 I=I-1 C *** If we are on an a byte boundary, we have finished checking the C *** right "leftover" bits. Go check the bytes in between. IF(MOD(I,8).EQ.7) GOTO 4740 C *** See if the current pixel is the correct color for solid color row. IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(I/8,J).AND.2**(7-MOD(I,8))) 2 .NE.WHITE) THEN GOTO 4720 ELSE GOTO 5000 ENDIF ELSE IF((BITMAP(I/8,J).AND.2**(7-MOD(I,8))) 2 .EQ.WHITE) THEN GOTO 4720 ELSE GOTO 5000 ENDIF ENDIF C *** C *** C *** C *** C *** 4740 CONTINUE C *** C *** Both the left and right "leftover" bits checked out to be solid C *** color of the current color type. Now need to check the C *** bytes in between to see if they are also solid color of the C *** current type. If it is not solid, we will go to the label C *** 5000 for processing, otherwise we will continue processing C *** below. DO 4750, K=ITMPCO,I,8 IF(LBLACK.EQ..TRUE.) THEN IF(BITMAP(K/8,J).NE.SOLBLK) GOTO 5000 ELSE IF(BITMAP(K/8,J).NE.SOLWHT) GOTO 5000 ENDIF 4750 CONTINUE C *** C *** We have a row which is of solid color. LSOLID=.TRUE. C *** C *** C *** C *** C *** C *** --------------------------------------------------------------- C *** C *** C *** Calculate the # of consecutive rows which are repeats of the current C *** row. Set IRPCNT=#repeated_consecutive_rows. C *** IRPCNT=0 4800 J=IROW-IRPCNT-1 C *** Need to make sure that we do not go out of the bounding box. IF(J.LT.IYBXLL) GOTO 8200 C *** Do a loop comparing the bytes across two rows. Since the bits C *** outside of the minimum bounding box are white (0), we do not C *** have to worry about them -- they will compare okay. C *** There are 8 bits to a byte, so there are 8 pixels to a byte. C *** We can step by 8 pixels to do our check. DO 4820, I=IXBXLL, IXBXUR, 8 IF(BITMAP(I/8,IROW).NE.BITMAP(I/8,J)) GOTO 4850 4820 CONTINUE C *** We have found another repeated consecutive row. IRPCNT=IRPCNT+1 C *** Go back and check if the next row down is also a repeated row. GOTO 4800 C *** C *** C *** C *** 4850 CONTINUE C *** We have found all of the consecutive repeated rows. C *** C *** ------------------------------------------------------------------ C *** Add up the sum of pixels on the (possibly repeated) solid rows C *** and add this result to any earlier sum (for the row which C *** had the last part of it solid). IRCSUM=IRCSUM+ (IXBXUR-IXBXLL+1)*(IRPCNT+1) C *** Update the cursor position to be the first pixel on the next C *** non-solid row below. IROW=IROW-IRPCNT-1 ICOL=IXBXLL C *** ------------------------------------------------------------------ C *** C *** Need to determine whether a transition occurs at the first C *** pixel of the first non-repeated solid row. If a transition does C *** not occur, goto label 4900, otherwise continue below. ITMPRO=IROW ITMPCO=IXBXLL IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 4900 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 4900 ENDIF C *** C *** ---------------------------------------------------------------- C *** C *** There is a transition at the first pixel of the minimum bounding C *** box for this first non-solid row. C *** C *** Write out the RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Change color. LBLACK=.NOT.LBLACK C *** Reset counters. IRPCNT=0 IRCSUM=0 C *** C *** We are now on the beginning of a new row. C *** GOTO BEGINNING_OR_ROW. GOTO 2000 C *** C *** ------------------------------------------------------------------------ C *** 4900 CONTINUE C *** C *** There is not a transition at the first pixel of the minimum bounding C *** box for this first non-solid row. We are located at this first pixel C *** of this non-solid row. C *** Find the location of the transition on this current row. C *** Find the transition point, (ITMPRO,ITMPCO). ITMPRO=IROW DO 4910, ITMPCO=IXBXLL+1,IXBXUR IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 4920 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 4920 ENDIF 4910 CONTINUE C *** 4920 CONTINUE C *** We now have ITMPRO, ITMPCO where the transition occurs. C *** Calculate the sum of the pixels up to the transition on this row, C *** and add this result to the earlier sum of solid (possibly repeated) C *** rows and the row which had the remaining end pixels to be of solid C *** color. IRCSUM=IRCSUM+(ITMPCO-IXBXLL) C *** Write out this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update position to the transition location. C *** IROW=ITMPRO We are still on the same row. ICOL=ITMPCO C *** Change colors. LBLACK=.NOT.LBLACK C *** Reset counters. IRPCNT=0 IRCSUM=0 C *** C *** We are now in the middle of a row, which may have possible repeats C *** and which may have the remainder of the row being a solid color C *** of the current type. GOTO MIDDLE_REPEAT. GOTO 3000 C *** C *** ------------------------------------------------------------------- C *** 5000 CONTINUE C *** C *** We are on a row, for which the previous row had the remaining C *** pixels on that row to be of solid color. We did not have C *** a transition at the first pixel of this row, and this row C *** is not of solid color. We are located at the first pixel C *** on this non-solid row. C *** C *** Locate the transition on this current row. C *** Find the transition point, (ITMPRO,ITMPCO). ITMPRO=IROW DO 5010, ITMPCO=IXBXLL+1,IXBXUR IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 5020 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 5020 ENDIF 5010 CONTINUE C *** 5020 CONTINUE C *** We now have ITMPRO, ITMPCO where the transition occurs. C *** Add up the sum of the pixels up to the transition with the C *** earlier sum for the previous row which had the pixels at the end C *** to be of solid color. IRCSUM=IRCSUM + (ITMPCO-IXBXLL) C *** Store this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the current position to be the point of transition. C *** IROW=ITMPRO It is on the same row. ICOL=ITMPCO C *** Change colors. LBLACK=.NOT.LBLACK C *** Reset counters. IRCSUM=0 IRPCNT=0 C *** C *** We are now in the middle of a row, for which there may be C *** possible repeats, and for which the remainder of this row C *** may be of solid color. GOTO MIDDLE_REPEAT. GOTO 3000 C *** C *** -------------------------------------------------------------------- C *** 6000 CONTINUE C *** C *** NOT SOLID BEGINNING_OF_ROW PROCESSING CONTINUED C *** C *** C *** --------------------------------------------------------------- C *** C *** C *** Calculate the # of consecutive rows which are repeats of the current C *** row. Set IRPCNT=#repeated_consecutive_rows. C *** IRPCNT=0 6100 J=IROW-IRPCNT-1 C *** Need to make sure that we do not go out of the bounding box. IF(J.LT.IYBXLL) GOTO 6200 C *** Do a loop comparing the bytes across two rows. Since the bits C *** outside of the minimum bounding box are white (0), we do not C *** have to worry about them -- they will compare okay. C *** There are 8 bits to a byte, so there are 8 pixels to a byte. C *** We can step by 8 pixels to do our check. DO 6120, I=IXBXLL, IXBXUR, 8 IF(BITMAP(I/8,IROW).NE.BITMAP(I/8,J)) GOTO 6150 6120 CONTINUE C *** We have found another repeated consecutive row. IRPCNT=IRPCNT+1 C *** Go back and check if the next row down is also a repeated row. GOTO 6100 C *** C *** C *** C *** 6150 CONTINUE C *** We have found all of the consecutive repeated rows. C *** C *** ------------------------------------------------------------------ 6200 CONTINUE C *** IF(IRPCNT.GT.0) THEN C *** Store the repeat count for later Encoding C *** and update the current position to be the last repeated row, C *** and reset the repeat counter. IF(LTX05E.EQ..TRUE.) IRPEAT(IRPIND)=IRCIND IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRPCNT IRPIND=IRPIND+1 IRCIND=IRCIND+1 IROW=IROW-IRPCNT IRPCNT=0 ENDIF C *** C *** Locate the transition on this current row. C *** Find the transition point, (ITMPRO,ITMPCO). ITMPRO=IROW DO 6210, ITMPCO=IXBXLL+1,IXBXUR IF(LBLACK.EQ..TRUE.) THEN IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .EQ.WHITE) GOTO 6220 ELSE IF((BITMAP(ITMPCO/8,ITMPRO).AND.2**(7-MOD(ITMPCO,8))) 2 .NE.WHITE) GOTO 6220 ENDIF 6210 CONTINUE C *** 6220 CONTINUE C *** We now have ITMPRO, ITMPCO where the transition occurs. C *** Add up the sum of the pixels up to the transition. IRCSUM=IRCSUM + (ITMPCO-IXBXLL) C *** Store this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the current position to be the point of transition. C *** IROW=ITMPRO It is on the same row. ICOL=ITMPCO C *** Change colors. LBLACK=.NOT.LBLACK C *** Reset counters. IRCSUM=0 IRPCNT=0 C *** C *** We are now in the middle of a row for which there are C *** no repeated rows immediately following, and for which the C *** remainder of the row may be of solid color. C *** GOTO MIDDLE_NO_REPEAT. GOTO 4000 C *** C *** ----------------------------------------------------------------- C *** 8000 CONTINUE C *** C *** LAST ROW OF CHARACTER PROCESSING for BEGINNING_OF_ROW SOLID last row. C *** C *** Add up the pixels of all of the solid (possibly repeated) rows C *** immediately above this last row which is solid. IRCSUM=IRCSUM+(IXBXUR-IXBXLL+1)*(IRPCNT+1) C *** Store this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update position, change color, reset counters, and exit. IROW=IROW-IRPCNT-1 ICOL=IXBXLL ITMPRO=IROW ITMPCO=ICOL LBLACK=.NOT.LBLACK IRCSUM=0 IRPCNT=0 GOTO 9000 C *** C *** ---------------------------------------------------------------------- C *** 8100 CONTINUE C *** C *** C *** C *** LAST ROW OF CHARACTER PROCESSING for a row which has the last pixels C *** on the row of solid color, but the whole row is not solid. C *** C *** Sum up the pixels remaining on this row. IRCSUM=IRCSUM+(IXBXUR-ICOL+1) C *** Store this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update position, change color, reset counters, and exit. IROW=IROW-1 ICOL=IXBXLL ITMPRO=IROW ITMPCO=ICOL LBLACK=.NOT.LBLACK IRPCNT=0 IRCSUM=0 GOTO 9000 C *** C *** ------------------------------------------------------------------ C *** 8200 CONTINUE C *** C *** C *** LAST ROW OF CHARACTER PROCESSING for a row which is solid C *** and may have had repeated solid rows above it and which C *** definitely had a row above it for which the last pixels on C *** the end of the row were of solid color of the current color. C *** C *** Add up all of the pixels on the solid and solid repeated rows C *** and add the earlier pixel count for the partially solid row. IRCSUM=IRCSUM + (IXBXUR-IXBXLL+1)*(IRPCNT+1) C *** Store this RUN CODE sum count for later Encoding. IF(LTX05E.EQ..TRUE.) IRUNCD(IRCIND)=IRCSUM IRCIND=IRCIND+1 C *** Update the position, change color, reset counters, and exit. IROW=IROW-IRPCNT-1 ICOL=IXBXLL ITMPRO=IROW ITMPCO=ICOL LBLACK=.NOT.LBLACK IRPCNT=0 IRCSUM=0 GOTO 9000 C *** C *** -------------------------------------------------------------------- C *** ------------------------------------------------------------------- C *** 9000 CONTINUE C *** C *** C *** Finished. Exiting. C *** C *** C *** C *** C------------------------------------------------------------------------ RETURN END C C *GRTX06 -- PGPLOT Calculate optimal value of dyn_f. C SUBROUTINE GRTX06 (IRUNCD,IRCDIM,IBOXDX,IBOXDY,IDYNF, 2 IRPEAT,IRPDIM,BITMAP,IBXDIM,IBYDIM) C----------------------------------------------------------------- C *** C *** ------------------------------------------------------------- C *** This routine is used to find the optimal value of dyn_f C *** for encoding the RUN CODE for the current PK Font character. C *** Documentation for the algorithm is found in the files PKtoPX.WEB, C *** PXtoPK.WEB, PKtype.WEB, and GFtoPK.WEB. To obtain this C *** documentation, WEAVE the WEB file, then TeX the output, then C *** use a dvi-translator the translate the DVI file into a binary C *** file suitable for output to your specific printer. C *** The PK format was designed by Tomas Rokicki in August, 1985. C *** Rokicki was a former Texas A&M Univerisity student. C *** C *** IRUNCD is an integer input array of dimension IRCDIM which contains C *** the RUN CODE for the current character. C *** IRCDIM is an integer input giving the dimension of the IRUNCD array. C *** IBOXDX is an integer input giving the X-direction size of the minimum C *** bounding box of the character. C *** IBOXDY is an integer input giving the Y-direction size of the minimum C *** bounding box of the character. C *** IDYNF is an integer output array of dimension 15 giving the C *** calculated value of dyn_f=(0,13) and the BITMAP encoding (14) C *** upon return from this routine. C *** BITMAP is a byte array of size IBXDIM x IBYDIM containing the C *** Bitmap of the character. C *** IBXDIM is an integer giving the X-dimension of the array BITMAP. C *** IBYDIM is an integer giving the Y-dimension of the array BITMAP. C *** IRPIND is an integer used to index into the IRPEAT array. C *** IRPEAT is an integer array of size IRPDIM which contains indexes C *** into the IRUNCD array pointing to Repeat codes in the RUN CODE C *** for the character. C *** IRPDIM is an integer giving the dimension of the array IRPEAT. C *** I, J are temporary integer variables used for counting and C *** for DO-loop indices. C *** C *** ---------------------------------------------------------------- C *** C *** C *** C *** IMPLICIT NONE INTEGER IRCDIM, IRPDIM, IBXDIM, IBYDIM, IBOXDX, I, J INTEGER IBOXDY, IRUNCD(IRCDIM), IRPEAT(IRPDIM), IRPIND BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1) INTEGER IDYNF(0:14),IVALUE(0:13,3) C *** C *** -------------------------------------------------------------- C *** Store data values used for comparisons below. DO 50, I=0,13 C *** One nybble values are C *** values from 1 to dyn_f. IVALUE(I,1) contains dyn_f=I. IVALUE(I,1)=I C *** Two nybble values are C *** values from dyn_f+1 to (13-dynf)*16+dynf . IVALUE(I,2)=(13-I)*16+I C *** Three nybble and larger #nybbles are C *** values from (13-dyn_f)*16+dyn_f up. IVALUE(I,3)=16-((13-I)*16+I+1) 50 CONTINUE C *** C *** -------------------------------------------------------------- C *** C *** Initialize the IDYNF array to zero (will be used to keep running C *** sums. DO 60, I=0,14 IDYNF(I)=0 60 CONTINUE C *** C *** C *** C *** ---------------------------------------------------------------- C *** C *** First, calculate the length required for the bitmap packing. C *** In bitmap packing, the minimal bounded box pixels are all C *** concatenated into one long string by concatenating rows, then C *** the bitmap string is packed 8 bits into a byte, each pixel C *** representing one bit in a byte. C *** C *** Note: 7/8=0 in integer arithmetic is used to round up the C *** extra bits over a byte at the end of the bitmapping up to C *** an even byte boundary. Also, there are 2 nybbles per byte. C *** So, IDYNF(14) will be the count in nybbles require for compressed C *** raw bitmapping. IDYNF(14)= (IBOXDX*IBOXDY+7)/8*2 C *** C *** C *** ----------------------------------------------------------------- C *** C *** Now calculate the length required for ENCODing the minimum bounded C *** box RUN CODE for different values of dyn_f=[0,13]. C *** DO 3000, J=0,13 C *** Calculate the length required for dyn_f=J ENCODing. IRPIND=1 DO 1000, I=1,IRCDIM C *** Check and see if the current RUN CODE value is a repeat code. IF(IRPIND.LE.IRPDIM) THEN IF(I.EQ.IRPEAT(IRPIND)) THEN C *** It is a repeat value. C *** Increment the Repeat Code index to point to the next repeat value. IRPIND=IRPIND+1. C *** We use the nybble value 14 to signify a repeat count value > 1, C *** and use the nybble value 15 to signify a repeat count value = 1, C *** then follows immediately the packed number representation C *** of the repeat value. For the signaling nybble (14, or 15), C *** we require 1 nybble. IDYNF(J)=IDYNF(J)+1 C *** If the repeat count is 1, then only the nybble value 15 is C *** required. We do not have to encode the packed number also. IF(IRUNCD(I).EQ.1) GOTO 1000 C *** C *** Now, we will calculate the number of nybbles required for the C *** packed number representation of the repeat count value below C *** (where all packed number representation nybble requirements C *** are determined --- repeat counts, white counts, or black counts). ENDIF ENDIF C *** C *** Calculate the number of nybbles required for the packed number C *** representation. C *** C *** First, check for the one nybble packed number representation of C *** the value. IF(IRUNCD(I).LE.IVALUE(J,1)) THEN C *** Note: The special case J=0 will not occur. A value of C *** zero for IRUNCD(I) signifies the end of the RUN CODE array C *** and was checked for above. IDYNF(J)=IDYNF(J)+1 GOTO 1000 ENDIF C *** C *** Second, check for the two nybble packed number representation of C *** the value. IF(IRUNCD(I).LE.IVALUE(J,2)) THEN C *** Note: J=13 will have been caught in the 1 nybble case above C *** so we do not have to worry about that special case. IDYNF(J)=IDYNF(J)+2 GOTO 1000 ENDIF C *** C *** Lastly, calculate the number of nybbles required for the C *** large (3 or more) nybble representation of the value. IDYNF(J)=IDYNF(J)+(INT((LOG( 2 FLOAT(IRUNCD(I)+IVALUE(J,3))) 2 /LOG(16.0) + 1 ))*2 -1) C *** 1000 CONTINUE 2000 CONTINUE 3000 CONTINUE C *** C *** C *** ------------------------------------------------------------- C *** Finished. Return with the results. C *** RETURN END C C *GRTX07 -- PGPLOT Compress the raw bitmap and DUMP encode. C SUBROUTINE GRTX07 (BITMAP,IBXDIM,IBYDIM,BENCOD,IBEDIM, 2 IXBXLL,IYBXLL,IXBXUR,IYBXUR) C------------------------------------------------------------------- C *** C *** C *** ---------------------------------------------------------------- C *** This routine is used to encode the BITMAP into a PK Font C *** by concatenating all of the rows inside of the character C *** into a single row, and storing each pixel as a 1-to-1 mapping C *** into the output array bits. One pixel is one bit in one of C *** the output array bytes. C *** C *** BITMAP is the byte input array of dimension IBXDIM x IBYDIM C *** containing the input PK Font character. C *** IBXDIM is an integer providing the X-dimension of the BITMAP array. C *** IBYDIM is an integer providing the Y-dimension of the BITMAP array. C *** BENCOD is the integer array of dimension IBEDIM, which upon output C *** will contain the ENCODEd BITMAP. C *** IBEDIM is an integer providing the dimension of BENCOD. C *** IXBXLL is an integer specifying the X-coordinate in pixel units C *** of the lower left corner of the minimum bounding box of the C *** PK Font character. C *** IYBXLL is an integer specifying the Y-coordinate in pixel units C *** of the lower left corner of the minimum bounding box of the C *** PK Font character. C *** IXBXUR is an integer specifying the X-coordinate in pixel units C *** of the upper right corner of the minimum bounding box of the C *** PK Font character. C *** IYBXUR is an integer specifying the Y-coordinate in pixel units C *** of the upper right of the minimum bounding box of the C *** PK Font character. C *** IBEIND is an integer variable, which upon output will contain C *** the number of bytes used of the array BECOD. IBEIND is used c *** as an index into the IBEIND array. C *** I, J are temporary integer variables used for counting and C *** and for DO-loop indices. C *** C *** C *** ---------------------------------------------------------------- C *** IMPLICIT NONE INTEGER IBXDIM, IBYDIM, IBEDIM, IXBXLL, IYBXLL INTEGER IXBXUR, IYBXUR, IBEIND, I, J BYTE BITMAP(0:IBXDIM-1,0:IBYDIM-1) INTEGER BENCOD(0:IBEDIM-1) C *** C *** C *** ---------------------------------------------------------------- C *** C *** C *** Initialize the variables. C *** IBEIND=0 DO 100, I=0, IBEDIM-1 BENCOD(I)=0 100 CONTINUE C *** C *** C *** ---------------------------------------------------------------- C *** C *** C *** Do the encoding by "ORing" the current output byte (BENCOD(IBEIND/8)) C *** with the value of the current input pixel (the IF statement) -- will C *** be the value 0 or non-zero -- and then multiplying the C *** value of the current pixel with the current output bit C *** position (assignment statement) -- which will be 2**7,...,2*0 according C *** to where you are within the current output byte}. C *** Note: it has been assumed that the bits are arranged from C *** left to right inside a byte as bit 7 (2**7), bit 6 (2**6), C *** ..., bit 1 (2**1), bit 0 (2**0), and that we traverse the C *** bitmap from left to right in increasing byte order ---- C *** If this is not true, then this routine must be modified. C *** I used BENCOD as an integer and '+' to implement the ".OR."ing. DO 300, J=IYBXUR, IYBXLL, -1 DO 200, I=IXBXLL, IXBXUR IF((BITMAP(I/8,J).AND.(2**(7-MOD(I,8)))).NE.0)THEN BENCOD(IBEIND/8)=BENCOD(IBEIND/8) + 2 (2**(7-MOD(IBEIND,8))) ENDIF IBEIND=IBEIND+1 200 CONTINUE 300 CONTINUE C *** C *** C *** C *** C *** ------------------------------------------------------------------- C *** Note: We do not have to worry about finishing packing the last C *** byte, since we zeroed out the array initially. The last byte will C *** have zeros as the last bits. C *** C *** ------------------------------------------------------------------ C *** C *** Now, we let's do a sanity check to make sure that I did not have C *** a programming error which went out of bounds on the BENCOD array. C *** IF(IBEIND.GT.IBEDIM*8) THEN CALL GRWARN('Exceeded the array dimension bounds of' 2 //' the array BENCOD.') CALL GRWARN('This routine was calculating the ' 2 //'ENCODEing of the BITMAP.') CALL GRWARN('This should never happen. This is a' 2 //' programming error in this routine.') ENDIF C *** C *** C *** ---------------------------------------------------------------- C *** C *** Finished. Let's return. C *** C *** RETURN END C C *GRTX08 -- PGPLOT ENCODE the RUN CODE count using optimal dyn_f. C SUBROUTINE GRTX08(IRUNCD,IRCDIM,IDYNF,IRPEAT,IRPDIM, 2 BENCOD,IBEDIM) C----------------------------------------------------------------- C *** C *** ------------------------------------------------------------- C *** This routine is used to encode the current PK Font character C *** using the optimal dyn_f value which was calculated earlier. C *** Documentation for the algorithm is found in the files PKtoPX.WEB, C *** PXtoPK.WEB, PKtype.WEB, and GFtoPK.WEB. To obtain this C *** documentation, WEAVE the WEB file, then TeX the output, then C *** use a dvi-translator the translate the DVI file into a binary C *** file suitable for output to your specific printer. C *** The PK format was designed by Tomas Rokicki in August, 1985. C *** Rokicki was a former Texas A&M Univerisity student. C *** C *** IRUNCD is an integer input array of dimension IRCDIM which contains C *** the RUN CODE for the current character. C *** IRCDIM is an integer input giving the dimension of the IRUNCD array. C *** IDYNF is an integer containing the optimal value of dyn_f which C *** was calculated earlier. dynf=[0,13]. C *** IRPIND is an integer used to index into the IRPEAT array. C *** IRPEAT is an integer array of size IRPDIM which contains indexes C *** into the IRUNCD array pointing to Repeat codes in the RUN CODE C *** for the character. C *** IRPDIM is an integer giving the dimension of the array IRPEAT. C *** BENCOD is an integer array of dimension IBEDIM which upon output C *** is to contain the ENCODEd value of the RUN CODE for the current C *** PK Font character. C *** IBEDIM is an integer giving the dimension of the array BENCOD. C *** IBEIND is an integer used to index into the array BENCOD C *** by indexing using IBEIND/2. C *** ITMPL is used as a temporary integer variable for the number of C *** nybbles required in part of the Large Packed number representation C *** calcluations. C *** ITMP1 is a temporary integer variable used in calculations C *** for the Large Packed number representation, and the 2 nybble C *** representation of the ENCODEd RUN CODE for the current Font character. C *** ITMP2 is a temporary integer variable used in calculations C *** for the Large Packed number representation, and the 2 nybble C *** representation of the ENCODEd RUN CODE for the current Font character. C *** I, K are temporary integer variables used for counting and C *** do-loop indices. C *** ---------------------------------------------------------------- C *** C *** C *** C *** IMPLICIT NONE INTEGER IRCDIM, IRPDIM, IBEDIM, IDYNF, I, K INTEGER IRUNCD(IRCDIM), IRPEAT(IRPDIM), IRPIND, IBEIND INTEGER ITMPL, ITMP1, ITMP2, I1NYBL, I2NYBL, ILNYBL INTEGER BENCOD(0:IBEDIM-1) C *** C *** -------------------------------------------------------------- C *** Calculate data values used for comparisons below. C *** One nybble values are C *** values from 1 to dyn_f. I1NYBL contains dyn_f=IDYNF. I1NYBL=IDYNF C *** Two nybble values are C *** values from dyn_f+1 to (13-dynf)*16+dynf . I2NYBL=(13-IDYNF)*16+IDYNF C *** Three nybble and larger #nybbles are C *** values from (13-dyn_f)*16+dyn_f up. ILNYBL=16-((13-IDYNF)*16+IDYNF+1) C *** C *** -------------------------------------------------------------- C *** C *** Initialize the BENCOD array to zero. DO 60, I=0,IBEDIM-1 BENCOD(I)=0 60 CONTINUE C *** C *** C *** C *** ---------------------------------------------------------------- C *** C *** Now calculate the ENCODEd RUN CODE for the minimum bounded C *** box using the optimal value dyn_f. C *** IBEIND=0 IRPIND=1 DO 1000, I=1,IRCDIM IF(IRPIND.LE.IRPDIM) THEN C *** Check and see if the current RUN CODE value is a repeat code. IF(I.EQ.IRPEAT(IRPIND)) THEN C *** It is a repeat value. C *** Increment the Repeat Code index to point to the next repeat value. IRPIND=IRPIND+1. C *** We use the nybble value 14 to signify a repeat count value > 1, C *** and use the nybble value 15 to signify a repeat count value = 1, C *** then follows immediately the packed number representation C *** of the repeat value. For the signaling nybble (14, or 15), C *** we require 1 nybble. C *** If the repeat count is 1, then only the nybble value 15 is C *** required. We do not have to encode the packed number also. IF(IRUNCD(I).EQ.1) THEN BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (15*16*MOD(IBEIND+1,2) + 15*MOD(IBEIND,2)) IBEIND=IBEIND+1 GOTO 1000 ELSE C *** However, if the repeat count was greater than 1, we have C *** to encode the nybble value 14 and then follow with the C *** packed number representation of the Repeat Count. BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (14*16*MOD(IBEIND+1,2) + 14*MOD(IBEIND,2)) IBEIND=IBEIND+1 ENDIF C *** C *** Now, we will calculate the packed number representation C *** of the repeat count value below (where all packed number C *** representations are determined --- repeat counts, C *** white pixel counts, or black pixel counts). ENDIF ENDIF C *** C *** Calculate the number of nybbles required for the packed number C *** representation and ENCODE the RUN CODE in packed format. C *** C *** First, check for the one nybble packed number representation of C *** the value. IF(IRUNCD(I).LE.I1NYBL) THEN C *** Note: The special case J=0 will not occur. A value of C *** zero for IRUNCD(I) signifies the end of the RUN CODE array C *** and was checked for above. BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (IRUNCD(I)*16*MOD(IBEIND+1,2) 3 + IRUNCD(I)*MOD(IBEIND,2)) IBEIND=IBEIND+1 GOTO 1000 ENDIF C *** C *** Second, check for the two nybble packed number representation of C *** the value. IF(IRUNCD(I).LE.I2NYBL) THEN C *** Note: J=13 will have been caught in the 1 nybble case above C *** so we do not have to worry about that special case. ITMP1=INT((IRUNCD(I)-1-IDYNF)/16) + 1 + IDYNF ITMP2=IRUNCD(I)-(ITMP1-IDYNF-1)*16 - IDYNF - 1 BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (ITMP1*16*MOD(IBEIND+1,2) 3 + ITMP1*MOD(IBEIND,2)) IBEIND=IBEIND+1 BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (ITMP2*16*MOD(IBEIND+1,2) 3 + ITMP2*MOD(IBEIND,2)) IBEIND=IBEIND+1 GOTO 1000 ENDIF C *** C *** Lastly, calculate the number of nybbles required to be zero C *** for the large (3 or more) nybble representation of the value. C *** Then encode that value as a large packed number. ITMPL=INT(LOG(FLOAT(IRUNCD(I)+ILNYBL))/LOG(16.0)+1)-1 DO 500, K=1,ITMPL C *** Place ITMPL zeroed nybbles into the BENCOD array. IBEIND=IBEIND+1 500 CONTINUE C *** Now, pack the value as a large packed number into array BENCOD. C *** Values greater than -ILNYBL=((13-dyn_f)*16+dyn_f)) are C *** large run counts. ITMP1=IRUNCD(I) + ILNYBL DO 600, K=1,ITMPL+1 ITMP2=INT(ITMP1/(16**(ITMPL-K+1))) BENCOD(IBEIND/2)=BENCOD(IBEIND/2) + 2 (ITMP2*16*MOD(IBEIND+1,2) 3 + ITMP2*MOD(IBEIND,2)) IBEIND=IBEIND+1 ITMP1=ITMP1-ITMP2*16**(ITMPL-K+1) 600 CONTINUE C *** C *** ---------------------------------------------------------------- C *** 1000 CONTINUE 2000 CONTINUE C *** Note: We do not need to finish packing the last nybble of a byte C *** because the byte was zeroed out at the start of this routine. C *** Let us now perform a sanity check to make sure that we did not C *** go out of bounds on the array BENCOD (if we did, it is a programming C *** error --- this should not ever happen). IF(IBEIND-1.GE.IBEDIM*2) THEN CALL GRWARN ('Exceeded array dimensions in the TeX PK' 2 //' Font RUN CODE ENCODEr routine.') CALL GRWARN ('Byte Array BENCOD bounds was exceeded.' 2 //' This is a programming error in that routine.') CALL GRWARN ('That should never occur.') ENDIF C *** C *** C *** C *** C *** ------------------------------------------------------------- C *** Finished. Return with the results. C *** RETURN END C C *GRTX09 -- PGPLOT Write out the current PK Font character to PK file. C SUBROUTINE GRTX09 (IBEDIM,BC,NC,XMAX,RESOLX,NDEV,DEVICE, 2 IXBXLL,IXBXUR,IYBXLL,IYBXUR,IDYNFO, 3 LIBLAK,NPKBYT,LUN,BENCOD,HEIGHT, 4 WIDTH,YMAX,RESOLY) C----------------------------------------------------------------------- C *** C *** IMPLICIT NONE INTEGER IBEDIM,BC,NC,NDEV,DEVICE,NPKBYT,LUN(2) INTEGER IXBXLL,IXBXUR,IYBXLL,IYBXUR,IDYNFO,FLAG INTEGER DM,DX,DY,W,H,HOFF,VOFF,PL(3),CC,I,ITMPVL INTEGER ITMPV1,ITMPV2,ITMPV3,ITMPV4,ITMP32,ITMP16 DOUBLE PRECISION TFM,TFMW,TFMH,TMPVAR REAL XMAX,RESOLX(NDEV),YMAX,RESOLY(NDEV) LOGICAL LIBLAK INTEGER BENCOD(IBEDIM),HEIGHT(0:15,4),WIDTH(0:15,4) INTEGER BYTOUT C *** C------------------------------------------------------------------------- C *** First, we need to calculate the Character Preamble paramaters C *** for the PK file for the short, short extended, and long formats. C *** The packet lengths are: PL(1)=8+IBEDIM PL(2)=13+IBEDIM PL(3)=28+IBEDIM C *** The Character code is: CC=BC+NC C *** The width values are: W=IXBXUR-IXBXLL+1 C *** The height values are: H=IYBXUR-IYBXLL+1 C *** The TFM value will be computed from: C TFM=XMAX/RESOLX(DEVICE)/1.3837 TFM=W/RESOLX(DEVICE)/1.3837 C *** {We will also calculate the char_info width and height table C *** values for the character here, WIDTH, HEIGHT in design size units}. TFMW=W/RESOLX(DEVICE)/1.3837 C TFMW=XMAX/RESOLX(DEVICE)/1.3837 TFMH=H/RESOLY(DEVICE)/1.3837 C TFMH=YMAX/RESOLY(DEVICE)/1.3837 C *** The DX ( or DM) values are: C DM=XMAX DM=W DX=DM*65536 C *** The DY values are 0. DY=0 C *** The horizontal offset values are: C HOFF=-IXBXLL HOFF=0 C *** The vertical offset values are: C VOFF=IYBXUR VOFF=H C *** C *** C *** ------------------------------------------------------------------ C *** C *** Now, we will determine which format of the preamble will be used -- C *** the long, the short, or the short extended. C *** C *** C *** We will use the short form if possible. SHORT_FORM: label 500. IF( (PL(1).LT.1024) .AND. (CC.LT.256) .AND. 2 (TFM.LT.16) .AND. (DM.LT.256) .AND. (W.LT.256) 3 .AND. (H.LT.256) .AND. (HOFF.GT.-129) 4 .AND. (HOFF.LT.128) .AND. (VOFF.GT.-129) 5 .AND. (VOFF.LT.128)) GOTO 500 C *** C *** C *** The short form was not possible. We will try to use the C *** short extended form. SHORT_EXT: label 2000. IF( (PL(2).LT.196608) .AND. (CC.LT.256) .AND. 2 (TFM.LT.16) .AND. (DM.LT.65536) .AND. (W.LT.65536) 3 .AND. (H.LT.65536) .AND. (HOFF.GT.-32769) 4 .AND. (HOFF.LT.32768) .AND. (VOFF.GT.-32769) 5 .AND. (VOFF.LT.32768)) GOTO 2000 C *** C *** C *** The short form, and the short extended forms were not possible. C *** The Long form had better work!. LONG_FORM: label 3500. IF( (PL(3).LT.2.147836*10**9) .AND. 2 (CC.LT.2.147836*10**9) .AND. 3 (TFM.LT.2048) .AND. (DM.LT.32768) .AND. 4 (W.LT.2.147836*10**9) .AND. (H.LT.2.147836*10**9) 5 .AND. (HOFF.GT.-2.147836*10**9) 6 .AND. (HOFF.LT.2.147836*10**9) .AND. 7 (VOFF.GT.-2.147836*10**9) 8 .AND. (VOFF.LT.2.147836*10**9)) GOTO 3500 C *** C *** --------------------------------------------------------------- C *** This file can not be output to a PK file. There is something wrong. C *** CALL GRWARN ('The PK file cannot be output to.') CALL GRQUIT ('Character Preamble Format for the ' 2 //'character is too large.') C *** C ----------------------------------------------------------------------- C *** C *** C *** C *** C *** C *** C *** C *** C *** C *** C -------------------------------------------------------------------------- 500 CONTINUE C *** C *** SHORT_FORMAT: C *** C *** C *** ----------------- C *** First, we write out the Flag (1 byte). FLAG=0 FLAG=FLAG+IDYNFO*16 IF((LIBLAK.EQ..TRUE.) .AND. (IDYNFO.LT.14)) 2 FLAG=FLAG + 2**3 ITMPVL=INT(PL(1)/256.0) FLAG=FLAG+ITMPVL BYTOUT=FLAG CALL GRTX11(LUN(1),BYTOUT) C *** C *** Second, we write out the Packet_Length (1 byte). BYTOUT=PL(1)-ITMPVL*256 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Third, we write out the Character_Code (1 byte). BYTOUT=CC CALL GRTX11(LUN(1),BYTOUT) C *** C *** Fourth, we write out the TFM_width (3 bytes). TMPVAR=TFM ITMPVL=INT(TMPVAR/16.0**(-1)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-1) ITMPVL=INT(TMPVAR/16.0**(-3)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-3) ITMPVL=INT(TMPVAR/16.0**(-5)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) C *** C *** Fifth, we write out the horizontal escapement (DM is 1 byte). BYTOUT=DM CALL GRTX11(LUN(1),BYTOUT) C *** C *** Sixth, we write out the Width of the bitmap (1 byte). BYTOUT=W CALL GRTX11(LUN(1),BYTOUT) C *** C *** Seventh, we write out the Height of the bitmap (1 byte). BYTOUT=H CALL GRTX11(LUN(1),BYTOUT) C *** C *** Eighth, we write out the Horizontal offset (signed 1 byte) C *** Since it is signed, we must take care of this. IF (HOFF.LT.0) THEN BYTOUT=HOFF+256 ELSE BYTOUT=HOFF ENDIF CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** Ninth, we write out the Vertical offset (signed 1 byte) C *** Since it is signed, we must take care of this. IF (VOFF.LT.0) THEN BYTOUT=VOFF+256 ELSE BYTOUT=VOFF ENDIF CALL GRTX11(LUN(1),BYTOUT) C *** C *** We just wrote out 11 bytes to the PK file. NPKBYT=NPKBYT+11 C *** Finished with the character Preamble, time to write out the character C *** to the PK file. C *** C *** C *** Write out the encoded character. GOTO 5000 C -------------------------------------------------------------------------- 2000 CONTINUE C *** C *** SHORT_EXT: C *** C *** ----------------- C *** First, we write out the Flag (1 byte). FLAG=0 FLAG=FLAG+IDYNFO*16 IF((LIBLAK.EQ..TRUE.) .AND. (IDYNFO.LT.14)) 2 FLAG=FLAG + 2**3 FLAG=FLAG+2**2 ITMPVL=INT(PL(2)/65536.0) FLAG=FLAG+ITMPVL BYTOUT=FLAG CALL GRTX11(LUN(1),BYTOUT) C *** C *** Second, we write out the Packet_Length (2 byte). ITMPVL=PL(2)-ITMPVL*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=ITMPVL-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** C *** Third, we write out the Character_Code (1 byte). BYTOUT=CC CALL GRTX11(LUN(1),BYTOUT) C *** C *** Fourth, we write out the TFM_width (3 bytes). TMPVAR=TFM ITMPVL=INT(TMPVAR/16.0**(-1)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-1) ITMPVL=INT(TMPVAR/16.0**(-3)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-3) ITMPVL=INT(TMPVAR/16.0**(-5)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** Fifth, we write out the horizontal escapement (DM is 2 byteS). ITMPV2=INT(DM/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=DM-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Sixth, we write out the Width of the bitmap (2 bytes). ITMPV2=INT(W/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=W-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Seventh, we write out the Height of the bitmap (2 bytes). ITMPV2=INT(H/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=H-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Eighth, we write out the Horizontal offset (signed 2 bytes) IF (HOFF.LT.0) THEN ITMPVL=HOFF+65536 ELSE ITMPVL=HOFF ENDIF ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=ITMPVL-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** Ninth, we write out the Vertical offset (signed 2 bytes). IF (VOFF.LT.0) THEN ITMPVL=VOFF+65536 ELSE ITMPVL=VOFF ENDIF ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPV1=ITMPVL-ITMPV2*256 BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** We just wrote out 17 bytes to the PK file. NPKBYT=NPKBYT+17 C *** Finished with the character Preamble, time to write out the character C *** to the PK file. C *** C *** C *** C *** C *** Write out the encoded character. GOTO 5000 C -------------------------------------------------------------------------- 3500 CONTINUE C *** C *** LONG_FORMAT: C *** C *** Note: All of these 4 byte quantites are "signed", but only C *** HOFF and VOFF can actually be negative. We did a check C *** on all of the other variables at the start of this routine. C *** We only have to worry about HOFF and VOFF being signed quantities. C *** ----------------- C *** First, we write out the Flag (1 byte). FLAG=0 FLAG=FLAG+IDYNFO*16 IF((LIBLAK.EQ..TRUE.) .AND. (IDYNFO.LT.14)) 2 FLAG=FLAG + 2**3 FLAG=FLAG+7 BYTOUT=FLAG CALL GRTX11(LUN(1),BYTOUT) C *** C *** Second, we write out the Packet_Length (4 bytes). ITMPVL=PL(3) ITMPV4=INT(ITMPVL/16777216.0) BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV4*16777216 ITMPV3=INT(ITMPVL/65536.0) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV3*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV2*256 ITMPV1=ITMPVL BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Third, we write out the Character_Code (1 byte). ITMPVL=CC ITMPV4=INT(ITMPVL/16777216.0) BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV4*16777216 ITMPV3=INT(ITMPVL/65536.0) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV3*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV2*256 ITMPV1=ITMPVL BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Fourth, we write out the TFM_width (4 bytes). TMPVAR=TFM ITMPVL=INT(TMPVAR/16.0**1) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**1 ITMPVL=INT(TMPVAR/16.0**(-1)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-1) ITMPVL=INT(TMPVAR/16.0**(-3)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) TMPVAR=TMPVAR-ITMPVL*16.0**(-3) ITMPVL=INT(TMPVAR/16.0**(-5)) BYTOUT=ITMPVL CALL GRTX11(LUN(1),BYTOUT) C *** C *** Fifth, we write out the horizontal escapement (DX is 4 bytes). C *** ITMPVL=DX ITMPV4=INT(ITMPVL/16777216.0) BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV4*16777216 ITMPV3=INT(ITMPVL/65536.0) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV3*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV2*256 ITMPV1=ITMPVL BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** Sixth, we write out the Vertical escapement (4 bytes). DY=0. DO 3600, I=1, 4 BYTOUT=0 CALL GRTX11(LUN(1),BYTOUT) 3600 CONTINUE C *** Seventh, we write out the Width of the bitmap (4 bytes). ITMPVL=W ITMPV4=INT(ITMPVL/16777216.0) BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV4*16777216 ITMPV3=INT(ITMPVL/65536.0) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV3*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV2*256 ITMPV1=ITMPVL BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Eighth, we write out the Height of the bitmap (4 bytes). ITMPVL=H ITMPV4=INT(ITMPVL/16777216.0) BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV4*16777216 ITMPV3=INT(ITMPVL/65536.0) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV3*65536 ITMPV2=INT(ITMPVL/256.0) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) ITMPVL=ITMPVL-ITMPV2*256 ITMPV1=ITMPVL BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** Ninth, we write out the Horizontal offset (signed 4 bytes). C *** This will be a negative quantity. But officially can be signed. C *** The result is NOT just two's complement as in the case with 2 byte C *** and 1 byte signed quantities. The first two bytes take care of C *** whether the quantity is signed or not, while the last two bytes C *** are positive. ITMP32=HOFF ITMP16=INT(ITMP32/65536.0) IF(ITMP16.LT.0) ITMP16=ITMP16+65536 ITMPV4=INT(ITMP16/256.0) ITMPV3=ITMP16-ITMPV4*256 ITMP16=ITMP32-ITMP16*65536 ITMPV2=INT(ITMP16/256.0) ITMPV1=ITMP16-ITMPV2*256 BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** C *** Tenth, we write out the Vertical offset (signed 4 bytes). C *** This will be a positive quantity. But officially can be signed. C *** The result is NOT just two's complement as in the case with 2 byte C *** and 1 byte signed quantities. The first two bytes take care of C *** whether the quantity is signed or not, while the last two bytes C *** are positive. ITMP32=VOFF ITMP16=INT(ITMP32/65536.0) IF(ITMP16.LT.0) ITMP16=ITMP16+65536 ITMPV4=INT(ITMP16/256.0) ITMPV3=ITMP16-ITMPV4*256 ITMP16=ITMP32-ITMP16*65536 ITMPV2=INT(ITMP16/256.0) ITMPV1=ITMP16-ITMPV2*256 BYTOUT=ITMPV4 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV3 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV2 CALL GRTX11(LUN(1),BYTOUT) BYTOUT=ITMPV1 CALL GRTX11(LUN(1),BYTOUT) C *** C *** We just wrote out 37 bytes to the PK file. NPKBYT=NPKBYT+37 C *** Finished with the character Preamble, time to write out the character C *** to the PK file. C *** C *** C *** C *** Write out the encoded character. GOTO 5000 C ------------------------------------------------------------------------- 5000 CONTINUE C *** C *** CHAR_WRITE: C *** C *** C *** C *** Write out the encode character information to the PK file. DO 5100, I=1,IBEDIM CALL GRTX11(LUN(1),BENCOD(I)) 5100 CONTINUE C *** We just wrote out IBEDIM bytes to the PK file. NPKBYT=NPKBYT+IBEDIM C *** C *** We need to finish up some bookkeeping, and calculate the TFM file C *** WIDTH and HEIGHT lookup values for this character. C *** We calculate TFMW and TFMH at the start of this routine, we now C *** just need to put them into a Fix_word representation (like the C *** PK files TFM width calculation for the large format of character C *** preamble. C *** First do the TFM WIDTH value calculation and store it for C *** this character. TMPVAR=TFMW ITMPVL=INT(TMPVAR/16.0**1) WIDTH(NC+1,1)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**1 ITMPVL=INT(TMPVAR/16.0**(-1)) WIDTH(NC+1,2)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**(-1) ITMPVL=INT(TMPVAR/16.0**(-3)) WIDTH(NC+1,3)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**(-3) ITMPVL=INT(TMPVAR/16.0**(-5)) WIDTH(NC+1,4)=ITMPVL C *** C *** Second, do the HEIGHT calculation and store it. TMPVAR=TFMH ITMPVL=INT(TMPVAR/16.0**1) HEIGHT(NC+1,1)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**1 ITMPVL=INT(TMPVAR/16.0**(-1)) HEIGHT(NC+1,2)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**(-1) ITMPVL=INT(TMPVAR/16.0**(-3)) HEIGHT(NC+1,3)=ITMPVL TMPVAR=TMPVAR-ITMPVL*16.0**(-3) ITMPVL=INT(TMPVAR/16.0**(-5)) HEIGHT(NC+1,4)=ITMPVL C *** C *** Finished. Let's return and do the next character if there are C *** any more. C ------------------------------------------------------------------------ RETURN END C C *GRTX10 -- PGPLOT Output the TFM file. C SUBROUTINE GRTX10(NC,ITFMUN,CHINFO,WIDTH,HEIGHT,BC) C *** ------------------------------------------------------------------- C *** We have limited the dimensions to support only 15 characters C *** per Font. ASCII codes "A" through a possible maximum of "O" C *** are assumed. TFM file limit of 16 different character C *** HEIGHT table lookup values was the reason for this choice of C *** limiting the Font to a maximum of 15 characters. Each of the C *** 15 characters will have exactly 1 entry in the character WIDTH C *** and HEIGHT lookup tables for simplicity. C *** C---------------------------------------------------------------------- IMPLICIT NONE INTEGER LF,BC,NC,I,J,ITFMUN C *** BC is the decimal value representing ASCII "A". C *** ECMAX is to be the 15th character after the starting C *** character (denoted by the value of BC). INTEGER BYTOUT, HEADER(0:16,4),CHINFO(BC:BC+14,4), 2 WIDTH(0:15,4),HEIGHT(0:15,4) C *** C *** =========================================================== C *** Have finished writing out the PK Font file. Now, write out C *** the TFM (TeX Font Metric) File. The TFM file should be C *** "SEQUENTIAL, FIXED-LENGTH 512 BYTES, NO CARRIAGE_CONTROL" C *** to match the other TFM files on the VAX. C *** TFM files require the most significant byte to appear in the C *** file before the less significant byte. VMS RMS will take C *** care of the order of reading and writing the bits in a byte. C *** So, as long as bytes are written out by this program in the C *** correct order, the bits will be okay. C *** C *** C *** Write out the total length of the TFM file in words (1 word=4 bytes). C *** High byte, low byte integer as is required throught the TFM file. C *** LF comes from 6 words (LF,LH,BC,EC,NW,NH,ND,NI,NL,NK,NE,NP values) C *** plus 17 header words, plus NC+1 char_info words, plus C *** NC+2 width table words, plus NC+2 height table words, C *** plus 1 depth word, plus 1 italic word, plus 7 parameter words. LF=37+3*NC BYTOUT = INT(LF/256.0) CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = LF - INT(LF/256.0)*256 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the length of the header data in words (1 word=4 bytes). C *** High byte, low byte integer format. BYTOUT=0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT=17 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the ASCII value to be used for the first Font character. C *** Value < 256 require by TFM file. High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = BC CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the ASCII value to be used for the last Font character. C *** BC <= Value <= BC+14 = ECMAX required by program dimensions and C *** algorithm used. TFM requires Value < 256. C *** High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = BC + NC CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the character WIDTH lookup table. C *** (One for each character was used for simplicity. Maximum of 15 C *** characters). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = NC + 2 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the character HEIGHT lookup table. C *** (One for each character was used for simplicity. Maximum of 15 C *** characters). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = NC + 2 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the character DEPTH lookup table. C *** (Only the value 0). Hight byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 1 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write the number of words in the character ITALIC correction lookup C *** table. (Only the value 0). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 1 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the character LIG/KERN lookup table. C *** (No values. This table is ommitted). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the character KERN lookup table. C *** (No values. This table is ommitted). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of words in the extensible character lookup table. C *** (No values. This table is ommitted). High byte, low byte integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** Write out the number of Font PARAMater words. High byte, low byte C *** integer format. BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 7 CALL GRTX12(ITFMUN,BYTOUT) C *** C *** C *** ------------------------------------------------------------------ C *** C *** Write out the HEADER information of the TFM file. C *** C *** ------------------------------------------------------------------ C *** C *** Store the 32 bit check sum, HEADER[0], that TeX will copy into the C *** DVI output file whenever it uses the font. This same checksum C *** should be in the FONT PK file as well. C *** I arbitrarily chose HEADER[0]=09281963 as the 32 bit Hex value. C *** (my birthdate is easy to remember...). HEADER(0,1) = 9 HEADER(0,2) = 2*16 + 8 HEADER(0,3) = 1*16 + 9 HEADER(0,4) = 6*16 + 3 C *** C *** Store HEADER[1], a Fix_word containing the design size of the C *** Font in TeX point units. (7227 TeX points = 254 cm.). C *** Note: This number must be at least 1.0. C *** [Fix_word is a 32-bit representation of a binary fraction. C *** Of the 32 bits in a Fix_word, exactly 12 are to the left of the C *** binary point. Thus, 2048-2**-20 >= Fixed_word >= -2048 ]. C *** I chosed 100.00 TeX points as the Font design size. Since many of C *** the fields in the TFM file must be expressed within 16 absolute C *** design-size units in value, 100.0 TeX points approximately = 1.38 C *** inches will allow up to approximately 22 inch output to be used. C *** HEADER[1]=100.0base10=64.0base16 = 06400000 . HEADER(1,1) = 0*16 + 6 HEADER(1,2) = 4*16 + 0 HEADER(1,3) = 0 HEADER(1,4) = 0 C *** C *** Store HEADER[2]...HEADER[11]. C *** These 40 bytes identify the character coding scheme. The first byte C *** gives the number of bytes that are used to contain the identifying C *** string. We will use 7 bytes to contain the string "GRAPHIC". C *** ASCII codes in Hex are "G"=47,"R"=52","A"=41,"P"=50,"H"=48, C *** "I"=49,"C"=43. So, in Hex, HEADER[2]=07475241, HEADER[3]=50484943, C *** HEADER[4]=00000000, HEADER[5]=00000000, HEADER[6]=00000000, C *** HEADER[7]=00000000, HEADER[8]=00000000, HEADER[9]=00000000, C *** HEADER[10]=00000000, HEADER[11]=00000000. C *** Storing thoses values, we have: HEADER(2,1) = 0*16 + 7 HEADER(2,2) = 4*16 + 7 HEADER(2,3) = 5*16 + 2 HEADER(2,4) = 4*16 + 1 HEADER(3,1) = 5*16 + 0 HEADER(3,2) = 4*16 + 8 HEADER(3,3) = 4*16 + 9 HEADER(3,4) = 4*16 + 3 C *** Storing HEADER[4]...HEADER[11] = 00000000, we have: DO 20, J=1,4 DO 10, I=4,11 HEADER(I,J)=0 10 CONTINUE 20 CONTINUE C *** C *** Store HEADER[12]...HEADER[16]. C *** These 20 bytes contain the Font family name in BCPL format. C *** This filed is know as the "Font identifier". I chose the 18 characters C *** "PGPLOT BITMAP DATA" for the Font name. ASCII values in HEX are: C *** "P"=50,"G"=47,"P"=50,"L"=4C,"O"=4F,"T"=54," "=20,"B"=42,"I"=49, C *** "T"=54,"M"=4D,"A"=41,"P"=50," "=20,"D"=44,"A"=41,"T"=54,"A"=41. C *** So, HEADER[12]=12504750, HEADER[13]=4C4F5420, HEADER[14]=4249544D, C *** HEADER[15]=41502044, HEADER[16]=41544100. C *** Storing these values, we have: HEADER(12,1) = 1*16 + 2 HEADER(12,2) = 5*16 + 0 HEADER(12,3) = 4*16 + 7 HEADER(12,4) = 5*16 + 0 HEADER(13,1) = 4*16 + 12 HEADER(13,2) = 4*16 + 15 HEADER(13,3) = 5*16 + 4 HEADER(13,4) = 2*16 + 0 HEADER(14,1) = 4*16 + 2 HEADER(14,2) = 4*16 + 9 HEADER(14,3) = 5*16 + 4 HEADER(14,4) = 4*16 + 13 HEADER(15,1) = 4*16 + 1 HEADER(15,2) = 5*16 + 0 HEADER(15,3) = 2*16 + 0 HEADER(15,4) = 4*16 + 4 HEADER(16,1) = 4*16 + 1 HEADER(16,2) = 5*16 + 4 HEADER(16,3) = 4*16 + 1 HEADER(16,4) = 0 C *** Note: I'm not sure what HEADER[17] accomplishes. I have NOT used it. C *** If it is to be used, then the Dimension of HEADER must be increased, C *** and the value written to the TFM file describing the length of C *** the HEADER array must be increased. C *** C *** Now write out the store HEADER array to the TFM file. DO 40, I = 0,16 DO 30, J=1,4 CALL GRTX12(ITFMUN,HEADER(I,J)) 30 CONTINUE 40 CONTINUE C *** C *** C *** Now write the previously stored char_info array, CHINFO, to the TFM file. DO 60, I =BC, BC+NC DO 50, J=1,4 CALL GRTX12(ITFMUN,CHINFO(I,J)) 50 CONTINUE 60 CONTINUE C *** C *** C *** Now write the previously store character width lookup array, WIDTH, C *** to the TFM file. DO 80, I = 0, NC+1 DO 70, J=1,4 CALL GRTX12(ITFMUN,WIDTH(I,J)) 70 CONTINUE 80 CONTINUE C *** C *** C *** Now write the previosly stored character height lookup array, HEIGHT, C *** to the TFM file. DO 100, I= 0, NC+1 DO 90, J=1,4 CALL GRTX12(ITFMUN,HEIGHT(I,J)) 90 CONTINUE 100 CONTINUE C *** C *** C *** Now write the character depth lookup array. C *** Note: WIDTH[0]=HEIGHT[0]=DEPTH[0]=ITALIC[0]=0 is required by TFM C *** file specifications. DO 110, I=1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 110 CONTINUE C *** C *** Now write the character italic lookup array. C *** Note: WIDTH[0]=HEIGHT[0]=DEPTH[0]=ITALIC[0]=0 is required by TFM C *** file specifications. DO 111, I=1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 111 CONTINUE C *** C *** Character LIG/KERN lookup table would have normally been written out here. C *** However, there are no entries in our table. I ommitted this table. C *** C *** C *** Character KERN lookup table would have normally been written out here. C *** However, there are no entries in our table. I ommitted this table. C *** C *** C *** Extensible character lookup table would have normally been written out C *** here. However, there are no entries in our table. I ommitted this table. C *** C *** C *** Now, write out the character PARAM array of Fix_words. C *** PARAM[1]=italic_slant = 00000000 (0.0) is the amount of italic slant. C *** PARAM[2]=space = 00001000 (0.001 design-size units = 1.0 TeX points C *** which approximately=0.0138 inches) is the normal C *** spacing between words in the text I arbitrarily chose. C *** PARAM[3]=space_stretch = 00000000 (0.0) is the glue stretching C *** between words of the text. C *** PARAM[4]=space_shrink = 00000000 (0.0) is the glue shrinking C *** between words of the text. C *** PARAM[5]=x_height = 00000000 (0.0) is the height of letters for C *** which accents don't have to be raised. C *** PARAM[6]=quad= 00001000 (0.001 design-size units = 1.0 TeX points C *** which approximately=0.0138 inches) is the size C *** I chose for one "em" in this Font. This was an C *** arbitrary choice. I do not believe this parameter C *** will be used--- but just in case... C *** PARAM[7]=extra_space = 00000000 (0.0) is the amount added to C *** PARAM[2] at the ends of sentences. C *** C *** Writing out these values for the PARAM array, C *** for PARAM[1] we have: DO 120, I = 1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 120 CONTINUE C *** for PARAM[2] we have: BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 1*16 + 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) C *** for PARAM[3] we have: DO 130, I = 1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 130 CONTINUE C *** for PARAM[4] we have: DO 140, I = 1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 140 CONTINUE C *** for PARAM[5] we have: DO 150, I = 1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 150 CONTINUE C *** for PARAM[6] we have: BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 1*16 + 0 CALL GRTX12(ITFMUN,BYTOUT) BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) C *** for PARAM[7] we have: DO 160, I = 1,4 BYTOUT = 0 CALL GRTX12(ITFMUN,BYTOUT) 160 CONTINUE C *** C *** C *** C *** =================================================================== C *** Finish writing the 512 byte record block on the Vax with 0's. C *** Note: TFM files do not require this...I just wanted to fill the C *** record (and block) on out, and I chose 0 to do this. DO 500, I=LF*4+1,512 BYTOUT=0 CALL GRTX12(ITFMUN,BYTOUT) 500 CONTINUE C *** RETURN END C C *GRTX11 -- PGPLOT buffering of PK file byte writes until 512 bytes buffered. C SUBROUTINE GRTX11 (ILUNIT,BYTOUT) C *** ------------------------------------------------------------------ C *** PK file writes... C *** ---------------------------------------------------------------- C *** The purpose of this file is to provide buffering of the writes C *** to the output PK file until 512 bytes can be written out together C *** as one record. C *** ILUNIT is the unit number of the output file. C *** BYTOUT is the byte sent to be buffered up for the record write. C *** This routine requires the SAVE statement. The variables C *** BUFFER and IBFIND must retain their values upon successive C *** calls!. C *** PORTABILITY NOTES: C *** This routine is system dependent. On a vax, a byte ranges from C *** -128 to 127 in decimal representation (For a Vax byte, C *** -128base10 is FF in hex) (For a Vax byte, 127base10 is 7F in hex). C *** So {[0,255]base10 integer } gets mapped to {[0,FF]base16 byte}, C *** which is interpreted as: C *** {[0,127]base10 integer } getting mapped to {[0,127]base10 byte} C *** while {[128,255]base10 integer} getting mapped C *** to {[-128,-1]base10 byte}. C *** Also, you may have to change the write statement below. C *** in *UNIX we are after "bytes on the disk" without any record C *** attributes in the middle of the record. Under *VMS I expect C *** RMS to take care of so that we get "bytes on the disk" appearance. C *** Routine GRTX12 also has this write statement that may need to C *** be modified. C---------------------------------------------------------------------- C *** IMPLICIT NONE SAVE INTEGER ILUNIT, IBFIND, I, BYTOUT, CONVBY,IRECRD BYTE BUFFER(512) C *** ------------------------------------------------------------ C *** Initialize some values to be set before the first time this C *** routine is entered. After the routine is entered, the values C *** will be changed and will retain their new "changed" values C *** upon successive calls to this routine. C *** DATA BUFFER /512*0/ DATA IBFIND /1/ DATA IRECRD /1/ C *** C *** ------------------------------------------------------------ C *** Convert the desired output value, BYTOUT, from its integer C *** form to the Vax_specific_required_signed_output form for C *** outputing a byte value, CONVBY. PORTABILITY NOTE: C *** This will very likely be different on different machines. C *** If the byte quantity is NOT signed on your machine, then C *** you should change the line CONVBY=BYTOUT-256 to C *** CONVBY=BYTOUT below!!!!. C *** IF(BYTOUT.GT.127) THEN CONVBY=BYTOUT-256 ELSE CONVBY=BYTOUT ENDIF C *** C *** Store the current byte that is to be output to the file. BUFFER(IBFIND)=CONVBY IF(MOD(IBFIND,512).EQ.0) THEN C *** We have buffered up 512 bytes. Time to write out a record C *** to the PK file and reset the buffer index IBFIND. C *** *VMS C *** If you have problems, you may want to try to change C *** this to a sequential write on the VAX. Routine GRTX12 C *** also has a write statement like the one below. WRITE(UNIT=ILUNIT,REC=IRECRD,ERR=1000) (BUFFER(I),I=1,512) IRECRD=IRECRD+1 IBFIND=0 ENDIF C *** C *** Increment the buffer index to the next element of the buffer. IBFIND=IBFIND+1 C *** C *** --------------------------------------------------------------- C *** Return to the calling routine. C *** C----------------------------------------------------------------------- RETURN 1000 CONTINUE CALL GRWARN('ERROR writing to the PK Font file.') CALL GRQUIT('EXITING to operating system. Routine GRTX11.') STOP C *** ----------------------- ENTRY GRTX14 C *** This part of GRTX11,GRTX14 is to reinitialze the file pointers C *** to the beginning of a new file. DO 1500, I=1,512 BUFFER(I)=0 1500 CONTINUE IBFIND=1 IRECRD=1 RETURN END C C *GRTX12 -- PGPLOT buffering of TFM file byte writes until 512 bytes buffered. C SUBROUTINE GRTX12 (ILUNIT,BYTOUT) C *** ------------------------------------------------------------------ C *** TFM file writes... C *** ---------------------------------------------------------------- C *** The purpose of this file is to provide buffering of the writes C *** to the output TFM file until 512 bytes can be written out together C *** as one record. C *** ILUNIT is the unit number of the output file. C *** BYTOUT is the byte sent to be buffered up for the record write. C *** This routine requires the SAVE statement. The variables C *** BUFFER and IBFIND must retain their values upon successive C *** calls!. C *** PORTABILITY NOTES: C *** This routine is system dependent. On a vax, a byte ranges from C *** -128 to 127 in decimal representation (For a Vax byte, C *** -128base10 is FF in hex) (For a Vax byte, 127base10 is 7F in hex). C *** So {[0,255]base10 integer } gets mapped to {[0,FF]base16 byte}, C *** which is interpreted as: C *** {[0,127]base10 integer } getting mapped to {[0,127]base10 byte} C *** while {[128,255]base10 integer} getting mapped C *** to {[-128,-1]base10 byte}. C *** Also, in *UNIX we want "bytes on the disk" with no interspersed C *** record information. Under *VMS I beileve that RMS will give us C *** the appearance of "bytes on the disk". You may have to C *** change this routine and routines GRTX11 in order to get C *** a stream of bytes on the disk without any record control information C *** interspersed in your file. C---------------------------------------------------------------------- C *** IMPLICIT NONE SAVE INTEGER ILUNIT, IBFIND, I, BYTOUT, CONVBY,IRECRD BYTE BUFFER(512) C *** ------------------------------------------------------------ C *** Initialize some values to be set before the first time this C *** routine is entered. After the routine is entered, the values C *** will be changed and will retain their new "changed" values C *** upon successive calls to this routine. C *** DATA BUFFER /512*0/ DATA IBFIND /1/ DATA IRECRD /1/ C *** C *** ------------------------------------------------------------ C *** Convert the desired output value, BYTOUT, from its integer C *** form to the Vax_specific_required_signed_output form for C *** outputing a byte value, CONVBY. PORTABILITY NOTE: C *** This will very likely be different on different machines. C *** If the byte quantity is NOT signed on your machine, then C *** you should change the line CONVBY=BYTOUT-256 to C *** CONVBY=BYTOUT below!!!!. C *** IF(BYTOUT.GT.127) THEN CONVBY=BYTOUT-256 ELSE CONVBY=BYTOUT ENDIF C *** C *** Store the current byte that is to be output to the file. BUFFER(IBFIND)=CONVBY IF(MOD(IBFIND,512).EQ.0) THEN C *** We have buffered up 512 bytes. Time to write out a record C *** to the TFM file and reset the buffer index IBFIND. C *** Under *VMS you may have to change this to a sequential C *** write. It seems to work okay for our DVI driver as direct C *** access. However, the original PK and TFM font files we have C *** look like sequential access. This line also appears in C *** routine GRTX11. WRITE(UNIT=ILUNIT,REC=IRECRD,ERR=1000) (BUFFER(I),I=1,512) IRECRD=IRECRD+1 IBFIND=0 ENDIF C *** C *** Increment the buffer index to the next element of the buffer. IBFIND=IBFIND+1 C *** C *** --------------------------------------------------------------- C *** Return to the calling routine. C *** C----------------------------------------------------------------------- RETURN 1000 CONTINUE CALL GRWARN('ERROR writing to the TFM Font file.') CALL GRQUIT('EXITING to operating system. Routine GRTX12.') STOP C *** ----------------------- ENTRY GRTX15 C *** This part of GRTX12,GRTX15 is to reinitialze the file pointers C *** to the beginning of a new file. DO 1500, I=1,512 BUFFER(I)=0 1500 CONTINUE IBFIND=1 IRECRD=1 RETURN END C C *GRTX13 -- TXDRIV routine to zero out the BITMAP array. C SUBROUTINE GRTX13 ( ISIZE , BITMAP, BYTVAL) C *** called by "CALL GRTX13 (BX*BY, %VAL(BITMAP),'00'X)" IMPLICIT NONE INTEGER ISIZE, I BYTE BITMAP(ISIZE),BYTVAL C -------------------------- DO 100, I=1, ISIZE BITMAP(I)=BYTVAL 100 CONTINUE RETURN END *** PARAM[7]=extra_space = 00000000 (0.0) is the amount added to C *** PARAM[2] at tpgplot/drivers/wddriv.f010064400040640000322000000406250652644137100156750ustar00tjpcitmbr00000400000017C*WDDRIV -- PGPLOT XWD drivers C+ SUBROUTINE WDDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR * * PGPLOT driver for X Window Dump (XWD) files. * * Supported device: XWD format * * Device type codes: /WD or /VWD * * Default device name: pgplot.xwd. * * If you have more than one image to plot (i.e. use PGPAGE) with this * device, subsequent pages will be named: pgplot2.xwd, pgplot3.xwd, * etc, disrespective of the device name you specified. * You can however bypass this by specifying a device name including a * number sign (#), which will henceforth be replaced by the pagenumber. * Example: page#.xwd will produce files page1.xwd, page2.xwd, ..., * page234.xwd, etc. * * Default view surface dimensions are: * - WD : 850 x 680 pixels (translates to 10.0 x 8.0 inch). * - VWD : 680 x 850 pixels (translates to 8.0 x 10.0 inch). * with an assumed scale of 85 pixels/inch. * Default width and height can be overridden by specifying environment * variables * PGPLOT_WD_WIDTH (default 850) * PGPLOT_WD_HEIGHT (default 680) * * Color capability: * Indices 0 to 255 are supported. Each of these indices can be assigned * one color. Default colors for indices 0 to 15 are implemented. * * Obtaining hardcopy: Use an XWD viewer (xwud) or converter. *= * 23-Jan-1995 - Steal GIDRIV.F code and bash appropriately [SCA]. * 28-Dec-1995 - Prevent concurrent access [TJP]. * 29-Apr-1996 - Use GRCTOI to decode environment variables [TJP]. *----------------------------------------------------------------------- CHARACTER*(*) LTYPE, PTYPE, DEFNAM INTEGER DWD, DHT, BX, BY PARAMETER (LTYPE= 1'WD (X Window Dump file, landscape orientation)', 2 PTYPE= 3'VWD (X Window Dump file, portrait orientation)') PARAMETER (DEFNAM='pgplot.xwd') PARAMETER (DWD=850, DHT=680) REAL XRES, YRES PARAMETER (XRES=85., YRES=XRES) C INTEGER UNIT, IC, NPICT, MAXIDX, STATE INTEGER CTABLE(3,0:255), CDEFLT(3,0:15) INTEGER IER, I, L, LL, IX0, IY0, IX1, IY1, USERH, USERW, JUNK INTEGER GRGMEM, GRFMEM, GROFIL, GRCFIL, GRCTOI CHARACTER*80 MSG, INSTR, FILENM C C Note: for 64-bit operating systems, change the following C declaration to INTEGER*8: C INTEGER PIXMAP C SAVE UNIT, IC, CTABLE, NPICT, MAXIDX, BX, BY, PIXMAP, FILENM SAVE CDEFLT, STATE DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ DATA STATE /0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in WD device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF (MODE.EQ.1) THEN CHR = LTYPE LCHR = LEN(LTYPE) ELSE IF (MODE.EQ.2) THEN CHR = PTYPE LCHR = LEN(PTYPE) ELSE CALL GRWARN('Requested MODE not implemented in WD driver') END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C (Maximum size is set by XWD format to 2**16 - 1 pixels) 20 RBUF(1) = 0 RBUF(2) = 65535 RBUF(3) = 0 RBUF(4) = 65535 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = XRES RBUF(2) = YRES RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, supports rectangle fill, pixel C primitives, and query color rep.) C 40 CHR = 'HNNNNRPNYN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = BX-1 RBUF(3) = 0 RBUF(4) = BY-1 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT XWD file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF C -- dimensions of plot buffer USERW = 0 USERH = 0 CALL GRGENV('WD_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) USERW = GRCTOI(INSTR(:L),LL) CALL GRGENV('WD_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) USERH = GRCTOI(INSTR(:L),LL) IF (MODE.EQ.1) THEN * -- Landscape BX = DWD IF (USERW.GE.8) BX = USERW BY = DHT IF (USERH.GE.8) BY = USERH ELSE * -- Portrait BX = DHT IF (USERH.GE.8) BX = USERH BY = DWD IF (USERW.GE.8) BY = USERW END IF NPICT=1 MAXIDX=0 * -- Initialize color table DO 95 I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) 95 CONTINUE DO 96 I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 96 CONTINUE * FILENM = CHR(:LCHR) CALL GRWD05 (FILENM, NPICT, MSG) UNIT = GROFIL (MSG) RBUF(1) = UNIT IF (UNIT.LT.0) THEN CALL GRWARN('Cannot open output file for WD plot') RBUF(2) = 0 ELSE RBUF(2) = 1 STATE = 1 END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE STATE = 0 RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE BX = NINT(RBUF(1))+1 BY = NINT(RBUF(2))+1 IER = GRGMEM(BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') BX = 0 BY = 0 PIXMAP = 0 END IF C -- initialize to zero (background color) IF (PIXMAP.NE.0) : CALL GRWD03(1, 1, BX, BY, 0, BX, BY, %VAL(PIXMAP)) IF (NPICT.GT.1) THEN CALL GRWD05 (FILENM, NPICT, MSG) UNIT = GROFIL(MSG) IF (UNIT.LT.0) THEN CALL GRWARN('Cannot open output file for WD plot') END IF END IF RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY0=BY-NINT(RBUF(2)) IY1=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRWD01(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IX0=NINT(RBUF(1))+1 IY0=BY-NINT(RBUF(2)) IF (PIXMAP.NE.0) : CALL GRWD01(IX0, IY0, IX0, IY0, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE IF (UNIT.GE.0) THEN CALL GRWD06(UNIT, BX, BY, CTABLE, %VAL(PIXMAP), MAXIDX) JUNK = GRCFIL(UNIT) END IF NPICT = NPICT+1 IER = GRFMEM(BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) MAXIDX = MAX(MAXIDX, IC) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE I = RBUF(1) CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill ------------------------------------------ C 240 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY1=BY-NINT(RBUF(2)) IY0=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRWD03(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=25, Not implemented ----------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE CALL GRWD04(NBUF, RBUF, BX, BY, %VAL(PIXMAP), MAXIDX) RETURN C C--- IFUNC=27, Not implemented ----------------------------------------- C 270 CONTINUE RETURN C C--- IFUNC=28, Not implemented ----------------------------------------- C 280 CONTINUE RETURN C C--- IFUNC=29, Query color representation. ----------------------------- C 290 CONTINUE I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END **GRWD01 -- PGPLOT WD driver, draw line *+ SUBROUTINE GRWD01 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY BYTE PIXMAP(BX,BY) * * Draw a straight-line segment from absolute pixel coordinates * (IX0, IY0) to (IX1, IY1). * * Arguments: * ICOL (input): Color index * PIXMAP (input/output): The image data buffer. *----------------------------------------------------------------------- INTEGER IX, IY, IS REAL D BYTE VAL C IF (ICOL .GT. 127) THEN VAL = ICOL - 256 ELSE VAL = ICOL END IF C IF (IX0.EQ.IX1 .AND. IY0.EQ.IY1) THEN PIXMAP(IX0,IY0)=VAL ELSE IF (ABS(IY1-IY0).GT.ABS(IX1-IX0)) THEN D=(IX1-IX0)/REAL(IY1-IY0) IS=1 IF (IY1.LT.IY0) IS=-1 DO 10 IY=IY0,IY1,IS IX=NINT(IX0+(IY-IY0)*D) PIXMAP(IX,IY)=VAL 10 CONTINUE ELSE D=(IY1-IY0)/REAL(IX1-IX0) IS=1 IF (IX1.LT.IX0) IS=-1 DO 20 IX=IX0,IX1,IS IY=NINT(IY0+(IX-IX0)*D) PIXMAP(IX,IY)=VAL 20 CONTINUE END IF END **GRWD02 -- Store unsigned 16-bit integer in host independent format *+ SUBROUTINE GRWD02(I, ARR) BYTE ARR(2) INTEGER I, TMP * TMP = MOD(I/256,256) IF (TMP .GT. 127) THEN ARR(1) = TMP - 256 ELSE ARR(1) = TMP END IF TMP = MOD(I,256) IF (TMP .GT. 127) THEN ARR(2) = TMP - 256 ELSE ARR(2) = TMP END IF END **GRWD03 -- PGPLOT WD driver, fill rectangle *+ SUBROUTINE GRWD03 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY BYTE PIXMAP(BX,BY) * * Arguments: * IX0, IY0 (input): Lower left corner. * IX1, IY1 (input): Upper right corner. * ICOL (input): Color value. * BX, BY (input): dimensions of PIXMAP. * PIXMAP (input/output): The image data buffer. *----------------------------------------------------------------------- INTEGER IX, IY BYTE VAL * IF (ICOL .GT. 127) THEN VAL = ICOL - 256 ELSE VAL = ICOL END IF DO 20 IY=IY0,IY1 DO 10 IX=IX0,IX1 PIXMAP(IX,IY) = VAL 10 CONTINUE 20 CONTINUE END **GRWD04 -- PGPLOT WD driver, fill image line *+ SUBROUTINE GRWD04(NBUF,RBUF,BX,BY,PIXMAP,MAXIDX) INTEGER I,J,NBUF,BX,BY,N,IC,MAXIDX REAL RBUF(NBUF) BYTE PIXMAP(BX,BY) *- I = NINT(RBUF(1))+1 J = BY-NINT(RBUF(2)) DO 10 N=3,NBUF IC=RBUF(N) IF (IC .GT. 127) THEN PIXMAP(I+N-3,J)=IC - 256 ELSE PIXMAP(I+N-3,J)=IC END IF MAXIDX=MAX(MAXIDX,IC) 10 CONTINUE END **GRWD05 -- Replace # in filename by picture number *+ SUBROUTINE GRWD05 (NAME1, NP, NAME2) CHARACTER*(*) NAME1 CHARACTER*(*) NAME2 CHARACTER*80 TMP INTEGER GRTRIM INTEGER NP, IDX, L, LN LN = GRTRIM(NAME1) IDX = INDEX(NAME1,'#') IF (IDX.GT.0) THEN C -- if the supplied name contains a #-character, replace C it with the page number CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE IF (NP.EQ.1) THEN C -- if this is the first page, use the supplied name NAME2 = NAME1 RETURN ELSE IF (LN+2.LE.LEN(NAME1)) THEN C -- append an underscore and the page number to the supplied C name NAME1(LN+1:LN+2) = '_#' CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE C -- last resort: invent a new name CALL GRFAO('pgplot#.xwd', L, TMP, NP, 0, 0, 0) END IF CALL GRWARN ('Writing new XWD image as: '//TMP(:L)) NAME2 = TMP(:L) END **GRWD06 -- PGPLOT WD driver, write XWD image *+ SUBROUTINE GRWD06 (UNIT, BX, BY, CTABLE, PIXMAP, MAXIDX) INTEGER UNIT, BX, BY, MAXIDX INTEGER CTABLE(3,0:255) BYTE PIXMAP(BX * BY) * * Write XWD image to UNIT. * * Arguments: * UNIT (input): Output unit * BX,BY (input): Image size * CTABLE (input): Color map * PIXMAP (input): Image data * MAXIDX (input): Maximum color index used. *-- * 23-Jan-1995 - New routine [SCA] *----------------------------------------------------------------------- BYTE COLOR(12), HEAD(107) INTEGER I, J, IER INTEGER GRWFIL DATA COLOR /0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0/ DATA HEAD / 0, 0, 0, 107, 0, 0, 0, 7, 1 0, 0, 0, 2, 0, 0, 0, 8, 2 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 1, 4 0, 0, 0, 8, 0, 0, 0, 1, 5 0, 0, 0, 8, 0, 0, 0, 8, 6 0, 0, 0, 0, 0, 0, 0, 3, 7 0, 0, 0, 0, 0, 0, 0, 0, 8 0, 0, 0, 0, 0, 0, 0, 8, 9 0, 0, 1, 0, 0, 0, 0, 0, A 0, 0, 0, 0, 0, 0, 0, 0, B 0, 0, 0, 0, 0, 0, 0, 0, C 0, 0, 0, 0, 80, 71, 80, 76, D 79, 84, 0/ * * Write image width into Header. * CALL GRWD02 (BX, HEAD(19)) CALL GRWD02 (BX, HEAD(51)) CALL GRWD02 (BX, HEAD(83)) * * Write image height into Header. * CALL GRWD02 (BY, HEAD(23)) CALL GRWD02 (BY, HEAD(87)) * * Write number of colors into Header. * CALL GRWD02 (MAXIDX + 1, HEAD(79)) * * Write Header. * IER = GRWFIL (UNIT, 107, HEAD) IF (IER .NE. 107) CALL GRWARN ('Error writing XWD header') * * Write out the color table. * DO J = 0, MAXIDX CALL GRWD02 (J, COLOR(3)) DO I = 1, 3 IF (CTABLE(I,J) .GT. 127) THEN COLOR(3 + I * 2) = CTABLE(I,J) - 256 ELSE COLOR(3 + I * 2) = CTABLE(I,J) END IF COLOR(4 + I * 2) = COLOR(3 + I * 2) END DO IER = GRWFIL (UNIT, 12, COLOR) END DO * * Write out the bitmap. * IER = GRWFIL (UNIT, BX * BY, PIXMAP) END SG(IER) CALL GRWARN('Failed to allocate plot buffer.') BX = 0 BY = 0 PIpgplot/drivers/psdriv.f010064400040640000322000001103510663405064200156740ustar00tjpcitmbr00000400000017C*PSDRIV -- PGPLOT PostScript drivers C+ SUBROUTINE PSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for PostScript devices. C C Version 1.2 - 1987 Aug 5 - T. J. Pearson. C Version 1.3 - 1987 Nov 16 - add "bind" commands to prolog - TJP. C Version 1.4 - 1988 Jan 28 - change dimensions so whole field can be C plotted - TJP. C Version 1.5 - 1988 Oct 27 - make EOF characters optional - TJP. C Version 1.6 - 1988 Dec 15 - standard Fortran - TJP. C Version 1.7 - 1989 Jul 5 - change color indices so most colors C are black - TJP. C Version 2.0 - 1990 Sep 10 - parameterize dimensions; correct C bounding box; add color support (from C D. Meier's CPdriver) - TJP. C Version 2.1 - 1991 Nov 29 - update Document Structuring Conventions C to version 3.0. C Version 3.0 - 1992 Sep 22 - add marker support; add CPS and VCPS C modes - TJP. C Version 3.1 - 1992 Nov 12 - up to 256 colors. C Version 3.2 - 1993 May 26 - correct error in marker support. C Version 4.0 - 1993 Sep 20 - trap Fortran I/O errors. C Version 4.1 - 1994 Aug 4 - make marker support optional. C Version 5.0 - 1994 Aug 30 - support for images. C Version 5.1 - 1994 Sep 7 - support for PGQCR. C Version 5.2 - 1994 Oct 12 - add IDENT option. C Version 5.3 - 1995 May 8 - recognise '-' as standard output; keep C track of bounding box; use upper case C for all defined commands; move C showpage outside save/restore. C Version 5.4 - 1995 Aug 19 - correct usage of PS_BBOX. C Version 6.0 - 1995 Dec 28 - reject concurrent access. C Version 6.1 - 1996 Apr 29 - decode environment variables using GRCTOI. C Version 6.2 - 1996 Oct 7 - correct bounding-box error (K-G Adams); C correct error in use of GCTOI (G Gonczi); C suppress <0 0 C> commands (R Scharroo); C allow arbitrary page size. C Version 6.3 - 1997 Nov 14 - shorter commands for setrgbcolor and setgray. C Version 6.4 - 1997 Nov 19 - workaround a Ghostscript bug: split long C polylines into shorter segments. C Version 6.5 - 1998 Feb 23 - support for real linewidth. C Version 6.6 - 1998 Nov 10 - provide easy way to convert color to grey. C Version 6.7 - 1998 Dec 12 - added #copies to header. C C Supported device: C Any printer that accepts the PostScript page description language, C eg, the LaserWriter (Apple Computer, Inc.). C PostScript is a trademark of Adobe Systems Incorporated. C C Device type code: C /PS (monochrome landscape mode, long edge of paper horizontal). C /CPS (color landscape mode, long edge of paper horizontal). C /VPS (monochrome portrait mode, short edge of paper horizontal). C /VCPS (color portrait mode, short edge of paper horizontal). C C Default file name: C pgplot.ps C C Default view surface dimensions: C 10.5 inches horizontal x 7.8 inches vertical (landscape mode), C 7.8 inches horizontal x 10.5 inches vertical (portrait mode). C These dimensions can be changed with environment variables. C C Resolution: C The driver uses coordinate increments of 0.001 inch, giving an C ``apparent'' resolution of 1000 pixels/inch. The true resolution is C device-dependent; eg, on an Apple LaserWriter it is 300 pixels/inch C (in both dimensions). C C Color capability (monochrome mode): C Color indices 0-255 are supported. Color index 0 is white (erase C or background color), indices 1-13 are black, 14 is light grey, C and 15 is dark grey. C C Color capability (color mode): C Color indices 0-255 are supported. Color index 0 is white (erase C or background color), index 1 is black, and indices 2-15 have the C standard PGPLOT color assignments. C C Input capability: none. C C File format: the file contains variable length records (maximum 132 C characters) containing PostScript commands. The commands use only C printable ASCII characters, and the file can be examined or modified C with a text editor. C C Obtaining hardcopy: use the operating system print or copy command to C send the file to a suitable device. C C Environment variables: C C PGPLOT_PS_WIDTH default 7800 C PGPLOT_PS_HEIGHT default 10500 C PGPLOT_PS_HOFFSET default 350 C PGPLOT_PS_VOFFSET default 250 C These variables tell PGPLOT how big an image to produce. The defaults C are appropriate for 8.5 x 11-inch paper. The maximum dimensions of C a PGPLOT image are WIDTH by HEIGHT, with the lower left corner offset C by HOFFSET horizontally and VOFFSET vertically from the lower left C corner of the paper. The units are milli-inches. The "top" of the C paper is the edge that comes out of the printer first. C C PGPLOT_IDENT C If this variable is set, the user name, date and time are written C in the bottom right corner of each page. C C PGPLOT_PS_BBOX C If this variable has value MAX, PGPLOT puts standard (full-page) C bounding-box information in the header of the PostScript file. If C the variable is unset or has some other value, PGPLOT puts the C correct (smallest) bounding box information in the trailer of the C PostScript file. C C PGPLOT_PS_EOF C Normally the output file does not contain special end-of-file C characters. But if environment variable PGPLOT_PS_EOF is defined C (with any value) PGPLOT writes a control-D job-separator character at C the beginning and at the end of the file. This is appropriate for C Apple LaserWriters using the serial interface, but it may not be C appropriate for other PostScript devices. C C PGPLOT_PS_MARKERS C Specify "NO" to suppress use of a PostScript font for the graph C markers; markers are then emulated by line-drawing. C C Document Structuring Conventions: C C The PostScript files conform to Version 3.0 of the Adobe Document C Structuring Conventions (see ref.3) and to version 3.0 of the C encapsulated PostScript file (EPSF) format. This should allow C the files to be read by other programs that accept the EPSF format. C Note, though, that multi-page plots are not valid EPSF files. The C files do not contain a screen preview section. C C References: C C (1) Adobe Systems, Inc.: PostScript Language Reference Manual. C Addison-Wesley, Reading, Massachusetts, 1985. C (2) Adobe Systems, Inc.: PostScript Language Tutorial and Cookbook. C Addison-Wesley, Reading, Massachusetts, 1985. C (3) Adobe Systems, Inc.: PostScript Language Reference Manual, Second C Edition. Addison-Wesley, Reading, Massachusetts, 1990. C----------------------------------------------------------------------- INTEGER DWD, DHT, DOFFW, DOFFH CHARACTER*(*) PTYPE, LTYPE, CPTYPE, CLTYPE, DEFNAM PARAMETER ( : PTYPE= 'VPS (PostScript file, portrait orientation)', : LTYPE= 'PS (PostScript file, landscape orientation)', : CPTYPE='VCPS (Colour PostScript file, portrait orientation)', : CLTYPE='CPS (Colour PostScript file, landscape orientation)') C PARAMETER (PTYPE='VPS', LTYPE='PS', CPTYPE='VCPS', CLTYPE='CPS') PARAMETER (DEFNAM='pgplot.ps') C -- printable paper area: in milli-inches; (WIDTH, HEIGHT) are C the dimensions of the printable area; OFFW, OFFH the offset from C the lower left corner of the paper PARAMETER (DWD=7800, DHT=10500, DOFFW=350, DOFFH=250) C INTEGER WIDTH, HEIGHT, OFFW, OFFH SAVE WIDTH, HEIGHT, OFFW, OFFH INTEGER IER, I0, J0, I1, J1, L, LL, LASTI, LASTJ, UNIT, LOBUF SAVE LASTI, LASTJ, UNIT, LOBUF INTEGER CI, NPTS, NPAGE, IOERR, LFNAME SAVE NPTS, NPAGE, IOERR, LFNAME INTEGER STATE, NSEG SAVE STATE, NSEG INTEGER NXP, NYP, XORG, YORG, XLEN, YLEN, N, RGB(3) INTEGER HIGH, LOW, I, K, KMAX, POSN, LD, LU INTEGER BBOX(4), BB1, BB2, BB3, BB4 SAVE BBOX INTEGER GROPTX, GRCTOI LOGICAL START, LANDSC, COLOR, STDOUT SAVE START, COLOR, STDOUT REAL LW SAVE LW REAL BBXMIN, BBXMAX, BBYMIN, BBYMAX SAVE BBXMIN, BBXMAX, BBYMIN, BBYMAX REAL RVALUE(0:255), GVALUE(0:255), BVALUE(0:255) SAVE RVALUE, GVALUE, BVALUE CHARACTER*20 SUSER, SDATE CHARACTER*120 INSTR, MSG CHARACTER*132 OBUF SAVE OBUF CHARACTER*255 FNAME SAVE FNAME INTEGER MARKER(0:31), NSYM, RAD(0:31) SAVE MARKER, RAD REAL MFAC SAVE MFAC REAL SHADE(0:15), RINIT(0:15), GINIT(0:15), BINIT(0:15) SAVE SHADE, RINIT, GINIT, BINIT CHARACTER*1 HEXDIG(0:15) DATA HEXDIG/'0','1','2','3','4','5','6','7', 1 '8','9','A','B','C','D','E','F'/ DATA SHADE /1.00, 13*0.00, 0.33, 0.67/ DATA RINIT 1 / 1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 2 1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67/ DATA GINIT 1 / 1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00, 2 0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67/ DATA BINIT 1 / 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00, 2 0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67/ DATA RAD/ 6, 1, 7, 6, 7, 5, 6, 8, : 7, 7, 9, 10, 9, 8, 6, 8, : 4, 5, 9, 12, 2, 4, 5, 7, : 11, 17, 22, 41, 9, 9, 9, 9/ DATA STATE/0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,900,900,260,900,280,290), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 IF (MODE.EQ.1) THEN C -- landscape, monochrome CHR = LTYPE LCHR = LEN(LTYPE) ELSE IF (MODE.EQ.2) THEN C -- portrait, monochrome CHR = PTYPE LCHR = LEN(PTYPE) ELSE IF (MODE.EQ.3) THEN C -- landscape, color CHR = CLTYPE LCHR = LEN(CLTYPE) ELSE C -- portrait, color CHR = CPTYPE LCHR = LEN(CPTYPE) END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = -1 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1000.0 RBUF(2) = 1000.0 RBUF(3) = 5 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, Area fill, C Thick lines, QCR, Markers [optional]) C 40 CONTINUE CHR = 'HNNATNQNYM' C -- Marker support suppressed? CALL GRGENV('PS_MARKERS', INSTR, L) IF (L.GE.2) THEN IF (INSTR(1:L).EQ.'NO' .OR. INSTR(1:L).EQ.'no') THEN CHR(10:10) = 'N' END IF END IF LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(3) = 0 LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN RBUF(2) = HEIGHT-1 RBUF(4) = WIDTH-1 ELSE RBUF(2) = WIDTH-1 RBUF(4) = HEIGHT-1 END IF NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 8 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT PostScript file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF C -- Color mode? CALL GRGENV('PS_COLOR', INSTR, L) COLOR = L.GT.0 .OR. MODE.EQ.3 .OR. MODE.EQ.4 IF (COLOR) THEN DO 91 CI=0,15 RVALUE(CI) = RINIT(CI) GVALUE(CI) = GINIT(CI) BVALUE(CI) = BINIT(CI) 91 CONTINUE ELSE DO 92 CI=0,15 RVALUE(CI) = SHADE(CI) GVALUE(CI) = SHADE(CI) BVALUE(CI) = SHADE(CI) 92 CONTINUE END IF DO 93 CI=16,255 RVALUE(CI) = 0.0 GVALUE(CI) = 0.0 BVALUE(CI) = 0.0 93 CONTINUE C -- Device dimensions WIDTH = DWD HEIGHT = DHT OFFW = DOFFW OFFH = DOFFH CALL GRGENV('PS_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) WIDTH = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) HEIGHT = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_HOFFSET', INSTR, L) LL = 1 IF (L.GT.0) OFFW = GRCTOI(INSTR(:L),LL) CALL GRGENV('PS_VOFFSET', INSTR, L) LL = 1 IF (L.GT.0) OFFH = GRCTOI(INSTR(:L),LL) STDOUT =CHR(1:LCHR).EQ.'-' IF (STDOUT) THEN UNIT = 6 C -- machine-dependent! ELSE CALL GRGLUN(UNIT) END IF NBUF = 2 RBUF(1) = UNIT IF (.NOT.STDOUT) THEN IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN MSG = 'Cannot open output file for PostScript plot: '// 1 CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 94 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 94 END IF RBUF(2) = 1 FNAME = CHR(:LCHR) LFNAME = LCHR END IF ELSE RBUF(2) = 1 FNAME = '-' LFNAME= 1 END IF STATE = 1 IOERR = 0 LOBUF = 0 LASTI = -1 LASTJ = -1 LW = 1 NPTS = 0 CALL GRGENV('PS_EOF', INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, CHAR(4)) CALL GRPS02(IOERR, UNIT, '%!PS-Adobe-3.0 EPSF-3.0') CALL GRUSER(INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, '%%For: '//INSTR(1:L)) CALL GRPS02(IOERR, UNIT, '%%Title: PGPLOT PostScript plot') CALL GRPS02(IOERR, UNIT, '%%Creator: PGPLOT [PSDRIV 6.6]') CALL GRDATE(INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, : '%%CreationDate: '//INSTR(1:L)) CALL GRGENV('PS_BBOX', INSTR, L) CALL GRTOUP(INSTR(1:3), INSTR(1:3)) IF (INSTR(1:3).EQ.'MAX') THEN C -- bounding box is based on maximum plot dimensions, not C actual dimensions CALL GRFAO('%%BoundingBox: # # # #', L, INSTR, : NINT(OFFW*0.072), NINT(OFFH*0.072), : NINT((WIDTH+OFFW)*0.072), NINT((HEIGHT+OFFH)*0.072)) CALL GRPS02(IOERR, UNIT, INSTR(:L)) ELSE CALL GRPS02(IOERR, UNIT, '%%BoundingBox: (atend)') END IF CALL GRPS02(IOERR, UNIT, '%%DocumentFonts: (atend)') CALL GRPS02(IOERR, UNIT, '%%LanguageLevel: 1') LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN CALL GRPS02(IOERR, UNIT, '%%Orientation: Landscape') ELSE CALL GRPS02(IOERR, UNIT, '%%Orientation: Portrait') END IF CALL GRPS02(IOERR, UNIT, '%%Pages: (atend)') CALL GRPS02(IOERR, UNIT, '%%EndComments') CALL GRPS02(IOERR, UNIT, '%%BeginProlog') CALL GRPS02(IOERR, UNIT, 1 '/L {moveto rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, 1 '/C {rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, 1 '/D {moveto 0 0 rlineto currentpoint stroke moveto} bind def') CALL GRPS02(IOERR, UNIT, '/LW {5 mul setlinewidth} bind def') CALL GRPS02(IOERR, UNIT, '/BP {newpath moveto} bind def') CALL GRPS02(IOERR, UNIT, '/LP /rlineto load def') CALL GRPS02(IOERR, UNIT, 1 '/EP {rlineto closepath eofill} bind def') CALL GRPS02(IOERR, UNIT, '/MB {gsave translate MFAC dup scale '// 1 '1 setlinewidth 2 setlinecap 0 setlinejoin newpath} bind def') CALL GRPS02(IOERR, UNIT, '/ME /grestore load def') CALL GRPS02(IOERR, UNIT, '/CC {0 360 arc stroke} bind def') CALL GRPS02(IOERR, UNIT, '/FC {0 360 arc fill} bind def') CALL GRPS02(IOERR, UNIT, '/G {1024 div setgray} bind def') CALL GRPS02(IOERR, UNIT, '/K {3 -1 roll 1024 div 3 -1 roll 1024'// : ' div 3 -1 roll 1024 div setrgbcolor} bind def') CALL GRPS02(IOERR, UNIT, '% Uncomment next line to convert color' : //' to grey shades') CALL GRPS02(IOERR, UNIT, '%/K {3 -1 roll 3413 div 3 -1 roll 1739' : //' div 3 -1 roll 9309 div add add setgray} bind def') CALL GRGENV('IDENT', INSTR, L) IF (L.GT.0) THEN CALL GRPS02(IOERR, UNIT, : '/RS{findfont exch scalefont setfont moveto dup'// : ' stringwidth neg exch neg exch rmoveto show} bind def') END IF CALL GRPS02(IOERR, UNIT, '%%EndProlog') CALL GRPS02(IOERR, UNIT, '%%BeginSetup') CALL GRPS02(IOERR, UNIT, '/#copies 1 def') CALL GRPS02(IOERR, UNIT, '%%EndSetup') NPAGE = 0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE CALL GRPS02(IOERR, UNIT, ' ') CALL GRPS02(IOERR, UNIT, '%%Trailer') CALL GRGENV('PS_BBOX', INSTR, L) CALL GRTOUP(INSTR(1:3), INSTR(1:3)) IF (INSTR(1:3).NE.'MAX') THEN CALL GRFAO('%%BoundingBox: # # # #', L, INSTR, : BBOX(1), BBOX(2), BBOX(3), BBOX(4)) CALL GRPS02(IOERR, UNIT, INSTR(:L)) END IF CALL GRPS02(IOERR, UNIT, '%%DocumentFonts: ') CALL GRFAO('%%Pages: #', L, INSTR, NPAGE, 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '%%EOF') CALL GRGENV('PS_EOF', INSTR, L) IF (L.GT.0) CALL GRPS02(IOERR, UNIT, CHAR(4)) IF (IOERR.NE.0) THEN CALL GRWARN('++WARNING++ Error '// 1 'writing PostScript file: file is incomplete') CALL GRWARN('Check for device full or quota exceeded') CALL GRWARN('Filename: '//FNAME(:LFNAME)) END IF IF (.NOT.STDOUT) THEN CLOSE (UNIT, IOSTAT=IOERR) IF (IOERR.NE.0) THEN CALL GRWARN('Error closing PostScript file '//FNAME(:LFNAME)) END IF CALL GRFLUN(UNIT) END IF STATE = 0 RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN HEIGHT = RBUF(1) WIDTH = RBUF(2) ELSE WIDTH = RBUF(1) HEIGHT = RBUF(2) END IF NPAGE = NPAGE+1 CALL GRPS02(IOERR, UNIT, ' ') CALL GRFAO('%%Page: # #', L, INSTR, NPAGE, NPAGE, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '%%BeginPageSetup') CALL GRPS02(IOERR, UNIT, '/PGPLOT save def') CALL GRPS02(IOERR, UNIT, '0.072 0.072 scale') LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 IF (LANDSC) THEN CALL GRFAO('# # translate 90 rotate', L, INSTR, WIDTH+OFFW, 1 OFFH, 0, 0) ELSE CALL GRFAO('# # translate', L, INSTR, OFFW, OFFH, 0, 0) END IF CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRPS02(IOERR, UNIT, '1 setlinejoin 1 setlinecap 1 LW 1') CALL GRPS02(IOERR, UNIT, '%%EndPageSetup') CALL GRPS02(IOERR, UNIT, '%%PageBoundingBox: (atend)') DO 111 NSYM=0,31 MARKER(NSYM) = 0 111 CONTINUE MFAC = 0.0 BBXMIN = WIDTH BBYMIN = HEIGHT BBXMAX = 0.0 BBYMAX = 0.0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN C -- suppress zero-length continuation segment IF (I0.EQ.I1 .AND. J0.EQ.J1) RETURN CALL GRFAO('# # C', L, INSTR, (I1-I0), (J1-J0), 0, 0) NSEG = NSEG+1 ELSE NSEG = 1 CALL GRFAO('# # # # L', L, INSTR, (I1-I0), (J1-J0), I0, J0) END IF LASTI = I1 IF (NSEG.GT.200) LASTI = -1 LASTJ = J1 BBXMIN = MIN(BBXMIN, I0-LW*5.0, I1-LW*5.0) BBXMAX = MAX(BBXMAX, I0+LW*5.0, I1+LW*5.0) BBYMIN = MIN(BBYMIN, J0-LW*5.0, J1-LW*5.0) BBYMAX = MAX(BBYMAX, J0+LW*5.0, J1+LW*5.0) GOTO 800 C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) CALL GRFAO('# # D', L, INSTR, I1, J1, 0, 0) LASTI = I1 LASTJ = J1 BBXMIN = MIN(BBXMIN, I1-LW*5.0) BBXMAX = MAX(BBXMAX, I1+LW*5.0) BBYMIN = MIN(BBYMIN, J1-LW*5.0) BBYMAX = MAX(BBYMAX, J1+LW*5.0) GOTO 800 C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (LOBUF.NE.0) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF LANDSC = MODE.EQ.1 .OR. MODE.EQ.3 C -- optionally write identification CALL GRGENV('IDENT', INSTR, L) IF (L.GT.0) THEN CALL GRUSER(SUSER, LU) CALL GRDATE(SDATE, LD) POSN = WIDTH - 1 IF (LANDSC) POSN = HEIGHT - 1 CALL GRFAO('('//SUSER(:LU)//' '//SDATE(:LD)// : ' [#]) # # 100 /Helvetica RS', : L, INSTR, NPAGE, POSN, 50, 0) CALL GRPS02(IOERR, UNIT, '0 G') CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF C -- optionally draw bounding box CALL GRGENV('PS_DRAW_BBOX', INSTR, L) IF (L.GT.0) THEN CALL GRFAO('0 G 0 LW newpath # # moveto', L, INSTR, : NINT(BBXMIN), NINT(BBYMIN), 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) CALL GRFAO('# # lineto # # lineto', L, INSTR, : NINT(BBXMIN), NINT(BBYMAX), NINT(BBXMAX), NINT(BBYMAX)) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) CALL GRFAO('# # lineto closepath stroke', L,INSTR, : NINT(BBXMAX), NINT(BBYMIN), 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF CALL GRPS02(IOERR, UNIT, 'PGPLOT restore showpage') CALL GRPS02(IOERR, UNIT, '%%PageTrailer') IF (LANDSC) THEN BB1 = INT((WIDTH-BBYMAX+OFFW)*0.072) BB2 = INT((BBXMIN+OFFH)*0.072) BB3 = 1+INT((WIDTH-BBYMIN+OFFW)*0.072) BB4 = 1+INT((BBXMAX+OFFH)*0.072) ELSE BB1 = INT((BBXMIN+OFFW)*0.072) BB2 = INT((BBYMIN+OFFH)*0.072) BB3 = 1+INT((BBXMAX+OFFW)*0.072) BB4 = 1+INT((BBYMAX+OFFH)*0.072) END IF CALL GRFAO('%%PageBoundingBox: # # # #', L, INSTR, : BB1, BB2, BB3, BB4) CALL GRPS02(IOERR, UNIT, INSTR(1:L)) IF (NPAGE.EQ.1) THEN BBOX(1) = BB1 BBOX(2) = BB2 BBOX(3) = BB3 BBOX(4) = BB4 ELSE BBOX(1) = MIN(BBOX(1),BB1) BBOX(2) = MIN(BBOX(2),BB2) BBOX(3) = MAX(BBOX(3),BB3) BBOX(4) = MAX(BBOX(4),BB4) END IF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) IF (COLOR) THEN CALL GRFAO('# # # K', L, INSTR, NINT(1024.*RVALUE(CI)), : NINT(1024.*GVALUE(CI)), NINT(1024.*BVALUE(CI)), 0) ELSE CALL GRFAO('# G', L, INSTR, NINT(1024.*RVALUE(CI)), 0, 0, 0) END IF LASTI = -1 GOTO 800 C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (LOBUF.NE.0) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) START = .TRUE. RETURN ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) IF (START) THEN CALL GRFAO('# # BP', L, INSTR, I0, J0, 0, 0) START = .FALSE. LASTI = I0 LASTJ = J0 ELSE IF (NPTS.EQ.0) THEN CALL GRFAO('# # EP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = -1 LASTJ = -1 ELSE CALL GRFAO('# # LP', L, INSTR, (I0-LASTI), 1 (J0-LASTJ), 0, 0) LASTI = I0 LASTJ = J0 END IF BBXMIN = MIN(BBXMIN, I0-LW*5.0) BBXMAX = MAX(BBXMAX, I0+LW*5.0) BBYMIN = MIN(BBYMIN, J0-LW*5.0) BBYMAX = MAX(BBYMAX, J0+LW*5.0) GOTO 800 END IF C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (COLOR) THEN CI = RBUF(1) RVALUE(CI) = RBUF(2) GVALUE(CI) = RBUF(3) BVALUE(CI) = RBUF(4) ELSE CI = RBUF(1) RVALUE(CI) = 0.30*RBUF(2) + 0.59*RBUF(3) + 0.11*RBUF(4) GVALUE(CI) = RVALUE(CI) BVALUE(CI) = RVALUE(CI) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE LW = RBUF(1) IF (INT(LW).EQ.LW) THEN CALL GRFAO('# LW', L, INSTR, INT(LW), 0, 0, 0) ELSE WRITE (INSTR,'(F6.2,'' LW'')') LW L = 9 END IF LASTI = -1 GOTO 800 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE IF (LOBUF.NE.0) THEN C -- flush buffer first CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF CALL GRPS02(IOERR, UNIT, CHR(:LCHR)) LASTI = -1 RETURN C C--- IFUNC=26, Image.--------------------------------------------------- C 260 CONTINUE N = RBUF(1) IF (N.EQ.0) THEN C -- First: setup for image C -- Set clipping region (RBUF(2...5)) NXP = RBUF(2) NYP = RBUF(3) XORG = RBUF(4) XLEN = RBUF(5) - RBUF(4) YORG = RBUF(6) YLEN = RBUF(7) - RBUF(6) BBXMIN = MIN(BBXMIN, RBUF(4), RBUF(5)) BBXMAX = MAX(BBXMAX, RBUF(4), RBUF(5)) BBYMIN = MIN(BBYMIN, RBUF(6), RBUF(7)) BBYMAX = MAX(BBYMAX, RBUF(6), RBUF(7)) C CALL GRPS02(IOERR, UNIT, 'gsave newpath') CALL GRFAO('# # moveto # 0 rlineto 0 # rlineto', L, INSTR, : XORG, YORG, XLEN, YLEN) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRFAO('# 0 rlineto closepath clip', L, INSTR, -XLEN, : 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) C -- CALL GRFAO('/picstr # string def', L, INSTR, NXP, 0, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) CALL GRFAO('# # 8 [', L, INSTR, NXP, NYP, 0, 0) CALL GRPS02(IOERR, UNIT, INSTR(:L)) WRITE (INSTR, '(6(1PE10.3, 1X), '']'')') (RBUF(I),I=8,13) CALL GRPS02(IOERR, UNIT, INSTR(:67)) IF (COLOR) THEN CALL GRPS02(IOERR, UNIT, : '{currentfile picstr readhexstring pop} false 3 colorimage') ELSE CALL GRPS02(IOERR, UNIT, : '{currentfile picstr readhexstring pop} image') END IF ELSE IF (N.EQ.-1) THEN C -- Last: terminate image CALL GRPS02(IOERR, UNIT, 'grestore') ELSE C -- Middle: write N image pixels; each pixel uses 6 chars C in INSTR, so N must be <= 20. L = 0 KMAX = 1 IF (COLOR) KMAX = 3 DO 262 I=1,N CI = RBUF(I+1) RGB(1) = NINT(255.0*RVALUE(CI)) RGB(2) = NINT(255.0*GVALUE(CI)) RGB(3) = NINT(255.0*BVALUE(CI)) DO 261 K=1,KMAX HIGH = RGB(K)/16 LOW = RGB(K)-16*HIGH L = L+1 INSTR(L:L) = HEXDIG(HIGH) L = L+1 INSTR(L:L) = HEXDIG(LOW) 261 CONTINUE 262 CONTINUE CALL GRPS02(IOERR, UNIT, INSTR(1:L)) END IF RETURN C C--- IFUNC=28, Marker.-------------------------------------------------- C 280 CONTINUE NSYM = NINT(RBUF(1)) C -- Output code for this marker if necessary IF (MARKER(NSYM).EQ.0) THEN IF (LOBUF.GT.0) CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 CALL GRPS03(IOERR, NSYM, UNIT) MARKER(NSYM) = 1 END IF C -- Output scale factor IF (RBUF(4).NE.MFAC) THEN IF (LOBUF.GT.0) CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) LOBUF = 0 MFAC = RBUF(4) WRITE (INSTR, '(''/MFAC '',F10.3,'' def'')') MFAC CALL GRPS02(IOERR, UNIT, INSTR(1:24)) END IF C -- Output an instruction to draw one marker I1 = NINT(RBUF(2)) J1 = NINT(RBUF(3)) CALL GRFAO('# # M#', L, INSTR, I1, J1, NSYM, 0) LASTI = -1 BBXMIN = MIN(BBXMIN, I1-MFAC*RAD(NSYM)) BBXMAX = MAX(BBXMAX, I1+MFAC*RAD(NSYM)) BBYMIN = MIN(BBYMIN, J1-MFAC*RAD(NSYM)) BBYMAX = MAX(BBYMAX, J1+MFAC*RAD(NSYM)) GOTO 800 C C--- IFUNC=29, Query color representation.------------------------------ C 290 CONTINUE CI = NINT(RBUF(1)) NBUF = 4 RBUF(2) = RVALUE(CI) RBUF(3) = GVALUE(CI) RBUF(4) = BVALUE(CI) RETURN C C----------------------------------------------------------------------- C Buffer output if possible. C 800 IF ( (LOBUF+L+1). GT. 132) THEN CALL GRPS02(IOERR, UNIT, OBUF(1:LOBUF)) OBUF(1:L) = INSTR(1:L) LOBUF = L ELSE IF (LOBUF.GT.1) THEN LOBUF = LOBUF+1 OBUF(LOBUF:LOBUF) = ' ' END IF OBUF(LOBUF+1:LOBUF+L) = INSTR(1:L) LOBUF = LOBUF+L END IF RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG, 1 '(''Unimplemented function in PS device driver: '',I10)') IFUNC CALL GRWARN(MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END C*GRPS03 -- PGPLOT PostScript driver, marker support C+ SUBROUTINE GRPS03(IOERR, NSYM, UNIT) INTEGER IOERR, NSYM, UNIT C C Write PostScript instructions for drawing graph marker number NSYM C on Fortran unit UNIT. C----------------------------------------------------------------------- CHARACTER*80 T(6) INTEGER I, N C IF (NSYM.LT.0 .OR. NSYM.GT.31) RETURN GOTO (100, 101, 102, 103, 104, 105, 106, 107, 108, 1 109, 110, 111, 112, 113, 114, 115, 116, 117, 2 118, 119, 120, 121, 122, 123, 124, 125, 126, 3 127, 128, 129, 130, 131) NSYM+1 C 100 T(1)='/M0 {MB -6 -6 moveto 0 12 rlineto 12 0 rlineto' T(2)='0 -12 rlineto closepath stroke ME} bind def' N=2 GOTO 200 101 T(1)='/M1 {MB 0 0 1 FC ME} bind def' N=1 GOTO 200 102 T(1)='/M2 {MB 0 7 moveto 0 -14 rlineto -7 0 moveto' T(2)='14 0 rlineto stroke ME} bind def' N=2 GOTO 200 103 T(1)='/M3 {MB 0 6 moveto 0 -6 lineto -5 3 moveto 5 -3 lineto' T(2)='5 3 moveto -5 -3 lineto stroke ME} bind def' N=2 GOTO 200 104 T(1)='/M4 {MB 0 0 7 CC ME} bind def' N=1 GOTO 200 105 T(1)='/M5 {MB -5 -5 moveto 10 10 rlineto -5 5 moveto' T(2)='10 -10 rlineto stroke ME} bind def' N=2 GOTO 200 106 T(1)='/M6 {MB -6 -6 moveto 0 12 rlineto 12 0 rlineto' T(2)='0 -12 rlineto closepath stroke ME} bind def' N=2 GOTO 200 107 T(1)='/M7 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='stroke ME} bind def' N=2 GOTO 200 108 T(1)='/M8 {MB 0 7 moveto 0 -14 rlineto -7 0 moveto 14 0 rlineto' T(2)='stroke 0 0 7 CC ME} bind def' N=2 GOTO 200 109 T(1)='/M9 {MB 0 0 1 FC 0 0 7 CC ME} bind def' N=1 GOTO 200 110 T(1)='/M10 {MB -9 9 moveto -8 7 lineto -7 3 lineto -7 -3 lineto' T(2)='-8 -7 lineto -9 -9 lineto -7 -8 lineto -3 -7 lineto' T(3)='3 -7 lineto 7 -8 lineto 9 -9 lineto 8 -7 lineto' T(4)='7 -3 lineto 7 3 lineto 8 7 lineto 9 9 lineto 7 8 lineto' T(5)='3 7 lineto -3 7 lineto -7 8 lineto closepath stroke' T(6)='ME} bind def' N=6 GOTO 200 111 T(1)='/M11 {MB 0 10 moveto -6 0 lineto 0 -10 lineto 6 0 lineto' T(2)='closepath stroke ME} bind def' N=2 GOTO 200 112 T(1)='/M12 {MB 0 9 moveto -2 3 lineto -8 3 lineto -3 -1 lineto' T(2)='-5 -7 lineto 0 -3 lineto 5 -7 lineto 3 -1 lineto 8 3' T(3)='lineto 2 3 lineto closepath stroke ME} bind def' N=3 GOTO 200 113 T(1)='/M13 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='fill ME} bind def' N=2 GOTO 200 114 T(1)='/M14 {MB -2 6 moveto -2 2 lineto -6 2 lineto -6 -2 lineto' T(2)='-2 -2 lineto -2 -6 lineto 2 -6 lineto 2 -2 lineto' T(3)='6 -2 lineto 6 2 lineto 2 2 lineto 2 6 lineto closepath' T(4)='stroke ME} bind def' N=4 GOTO 200 115 T(1)='/M15 {MB 0 8 moveto -7 -4 lineto 7 -4 lineto closepath' T(2)='0 -8 moveto 7 4 lineto -7 4 lineto closepath stroke ME}' T(3)='bind def' N=3 GOTO 200 116 T(1)='/M16 {MB -4 -4 moveto 0 8 rlineto 8 0 rlineto 0 -8' T(2)='rlineto closepath fill ME} bind def' N=2 GOTO 200 117 T(1)='/M17 {MB 0 0 4.5 FC ME} bind def' N=1 GOTO 200 118 T(1)='/M18 {MB 0 9 moveto -2 3 lineto -8 3 lineto -3 -1 lineto' T(2)=' -5 -7 lineto 0 -3 lineto 5 -7 lineto 3 -1 lineto 8 3' T(3)='lineto 2 3 lineto closepath fill ME} bind def' N=3 GOTO 200 119 T(1)='/M19 {MB -12 -12 moveto 0 24 rlineto 24 0 rlineto 0 -24' T(2)='rlineto closepath stroke ME} bind def' N=2 GOTO 200 120 T(1)='/M20 {MB 0 0 2 CC ME} bind def' N=1 GOTO 200 121 T(1)='/M21 {MB 0 0 4 CC ME} bind def' N=1 GOTO 200 122 T(1)='/M22 {MB 0 0 5 CC ME} bind def' N=1 GOTO 200 123 T(1)='/M23 {MB 0 0 7 CC ME} bind def' N=1 GOTO 200 124 T(1)='/M24 {MB 0 0 11 CC ME} bind def' N=1 GOTO 200 125 T(1)='/M25 {MB 0 0 17 CC ME} bind def' N=1 GOTO 200 126 T(1)='/M26 {MB 0 0 22 CC ME} bind def' N=1 GOTO 200 127 T(1)='/M27 {MB 0 0 41 CC ME} bind def' N=1 GOTO 200 128 T(1)='/M28 {MB -6 2 moveto -9 0 lineto -6 -2 lineto -3 5' T(2)='moveto -8 0 lineto -3 -5 lineto -8 0 moveto 9 0 lineto' T(3)='stroke ME} bind def' N=3 GOTO 200 129 T(1)='/M29 {MB 6 2 moveto 9 0 lineto 6 -2 lineto 3 5 moveto' T(2)='8 0 lineto 3 -5 lineto 8 0 moveto -9 0 lineto stroke ME}' T(3)='bind def' N=3 GOTO 200 130 T(1)='/M30 {MB 2 6 moveto 0 9 lineto -2 6 lineto 5 3 moveto' T(2)='0 8 lineto -5 3 lineto 0 8 moveto 0 -9 lineto stroke ME}' T(3)='bind def' N=3 GOTO 200 131 T(1)='/M31 {MB 2 -6 moveto 0 -9 lineto -2 -6 lineto 5 -3' T(2)='moveto 0 -8 lineto -5 -3 lineto 0 -8 moveto 0 9 lineto' T(3)='stroke ME} bind def' N=3 GOTO 200 C 200 DO 210 I=1,N CALL GRPS02(IOERR, UNIT, T(I)) 210 CONTINUE C END C*GRPS02 -- PGPLOT PostScript driver, copy buffer to file C+ SUBROUTINE GRPS02 (IER, UNIT, S) C C Support routine for PSdriver: write character string S on C specified Fortran unit. C C Error handling: if IER is not 0 on input, the routine returns C immediately. Otherwise IER receives the I/O status from the Fortran C write (0 => success). C----------------------------------------------------------------------- INTEGER IER, UNIT CHARACTER*(*) S C IF (IER.EQ.0) THEN WRITE (UNIT, '(A)', IOSTAT=IER) S IF (IER.NE.0) CALL 1 GRWARN('++WARNING++ Error writing PostScript file') END IF C----------------------------------------------------------------------- END -------------------------------------------------- C 260 CONTINUE N = RBUF(1) IF (N.EQ.0) THEN C -- First: setup for image C -- Set clipping region (RBUF(2...5)) NXP = RBUF(2) NYP = RBUF(3) XORG = RBUF(4) XLENpgplot/drivers/gidriv.f010064400040640000322000000473230652644150100156570ustar00tjpcitmbr00000400000017C*GIDRIV -- PGPLOT GIF drivers C+ SUBROUTINE GIDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR * * PGPLOT driver for Graphics Interchange Format (GIF) files. * ************************************************************************ * CAUTION * * * * The GIF specification incorporates the Lempel-Zev-Welch (LZW) * * compression technology which is the subject of a patent awarded to * * Unisys. Use of this technology, and in particular creation of GIF * * format files using this PGPLOT device driver, may require a license * * from Unisys. * ************************************************************************ * * Supported device: GIF87a file format * * Device type codes: /GIF or /VGIF * * Default device name: pgplot.gif. * * If you have more than one image to plot (i.e. use PGPAGE) with this * device, subsequent pages will be named: pgplot2.gif, pgplot3.gif, * etc, disrespective of the device name you specified. * You can however bypass this by specifying a device name including a * number sign (#), which will henceforth be replaced by the pagenumber. * Example: page#.gif will produce files page1.gif, page2.gif, ..., * page234.gif, etc. * * Default view surface dimensions are: * - GIF : 850 x 680 pixels (translates to 10.0 x 8.0 inch). * - VGIF : 680 x 850 pixels (translates to 8.0 x 10.0 inch). * with an assumed scale of 85 pixels/inch. * Default width and height can be overridden by specifying environment * variables * PGPLOT_GIF_WIDTH (default 850) * PGPLOT_GIF_HEIGHT (default 680) * * Color capability: * Indices 0 to 255 are supported. Each of these indices can be assigned * one color. Default colors for indices 0 to 15 are implemented. * * Obtaining hardcopy: Use a GIF viewer or converter. *= * 1-Aug-1994 - Created by Remko Scharroo * 9-Aug-1994 - New scheme for line plotting * 16-Aug-1994 - Provide multi-image plotting. * 8-Sep-1994 - Add opcode 29 [TJP]. * 5-Nov-1994 - Adjust size of bitmap if necessary [TJP]. * 18-Jan-1995 - Attempt to prevent integer overflow on systems where * BYTE is signed [TJP]. * 28-Dec-1995 - prevent concurrent access [TJP]. * 29-Apr-1996 - use GRCTOI to decode environment variables [TJP]. * 2-Sep-1997 - correct a byte overflow problem *----------------------------------------------------------------------- CHARACTER*(*) LTYPE, PTYPE, DEFNAM INTEGER DWD, DHT, BX, BY PARAMETER (LTYPE= 1'GIF (Graphics Interchange Format file, landscape orientation)', 2 PTYPE= 3'VGIF (Graphics Interchange Format file, portrait orientation)') PARAMETER (DEFNAM='pgplot.gif') PARAMETER (DWD=850, DHT=680) REAL XRES, YRES PARAMETER (XRES=85., YRES=XRES) C INTEGER UNIT, IC, NPICT, MAXIDX, STATE INTEGER CTABLE(3,0:255), CDEFLT(3,0:15) INTEGER IER, I, L, LL, IX0, IY0, IX1, IY1, USERW, USERH, JUNK INTEGER GRGMEM, GRFMEM, GROFIL, GRCFIL, GRCTOI CHARACTER*80 MSG, INSTR, FILENM C C Note: for 64-bit operating systems, change the following C declaration to INTEGER*8: C INTEGER PIXMAP, WORK C SAVE UNIT, IC, CTABLE, NPICT, MAXIDX, BX, BY, PIXMAP, FILENM SAVE CDEFLT, STATE DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ DATA STATE /0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in GIF device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF (MODE.EQ.1) THEN CHR = LTYPE LCHR = LEN(LTYPE) ELSE IF (MODE.EQ.2) THEN CHR = PTYPE LCHR = LEN(PTYPE) ELSE CALL GRWARN('Requested MODE not implemented in GIF driver') END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C (Maximum size is set by GIF format to 2**16 pixels) 20 RBUF(1) = 0 RBUF(2) = 65536 RBUF(3) = 0 RBUF(4) = 65536 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = XRES RBUF(2) = YRES RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, supports rectangle fill, pixel C primitives, and query color rep.) C 40 CHR = 'HNNNNRPNYN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = BX-1 RBUF(3) = 0 RBUF(4) = BY-1 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT GIF file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF C -- dimensions of plot buffer USERW = 0 USERH = 0 CALL GRGENV('GIF_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) USERW = GRCTOI(INSTR(:L),LL) CALL GRGENV('GIF_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) USERH = GRCTOI(INSTR(:L),LL) IF (MODE.EQ.1) THEN * -- Landscape BX = DWD IF (USERW.GE.8) BX = USERW BY = DHT IF (USERH.GE.8) BY = USERH ELSE * -- Portrait BX = DHT IF (USERH.GE.8) BX = USERH BY = DWD IF (USERW.GE.8) BY = USERW END IF NPICT=1 MAXIDX=0 * -- Initialize color table DO 95 I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) 95 CONTINUE DO 96 I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 96 CONTINUE * FILENM = CHR(:LCHR) CALL GRGI10 (FILENM, NPICT, MSG) UNIT = GROFIL (MSG) RBUF(1) = UNIT IF (UNIT.LT.0) THEN CALL GRWARN('Cannot open output file for GIF plot') RBUF(2) = 0 ELSE RBUF(2) = 1 STATE = 1 END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE STATE = 0 RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE BX = NINT(RBUF(1))+1 BY = NINT(RBUF(2))+1 IER = GRGMEM(BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') BX = 0 BY = 0 PIXMAP = 0 END IF C -- initialize to zero (background color) IF (PIXMAP.NE.0) : CALL GRGI03(1, 1, BX, BY, 0, BX, BY, %VAL(PIXMAP)) IF (NPICT.GT.1) THEN CALL GRGI10 (FILENM, NPICT, MSG) UNIT = GROFIL(MSG) IF (UNIT.LT.0) THEN CALL GRWARN('Cannot open output file for GIF plot') END IF END IF RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY0=BY-NINT(RBUF(2)) IY1=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRGI01(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IX0=NINT(RBUF(1))+1 IY0=BY-NINT(RBUF(2)) IF (PIXMAP.NE.0) : CALL GRGI01(IX0, IY0, IX0, IY0, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE IF (UNIT.GE.0) THEN IER = GRGMEM(2*256*4098, WORK) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate work array.') ELSE CALL GRGI06(UNIT, BX, BY, CTABLE, %VAL(PIXMAP), MAXIDX, : %VAL(WORK)) END IF JUNK = GRCFIL(UNIT) IER = GRFMEM(2*256*4098, WORK) END IF NPICT = NPICT+1 IER = GRFMEM(BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) MAXIDX = MAX(MAXIDX, IC) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE I = RBUF(1) CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill ------------------------------------------ C 240 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY1=BY-NINT(RBUF(2)) IY0=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRGI03(IX0, IY0, IX1, IY1, IC, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=25, Not implemented ----------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE CALL GRGI04(NBUF, RBUF, BX, BY, %VAL(PIXMAP), MAXIDX) RETURN C C--- IFUNC=27, Not implemented ----------------------------------------- C 270 CONTINUE RETURN C C--- IFUNC=28, Not implemented ----------------------------------------- C 280 CONTINUE RETURN C C--- IFUNC=29, Query color representation. ----------------------------- C 290 CONTINUE I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END **GRGI01 -- PGPLOT GIF driver, draw line *+ SUBROUTINE GRGI01 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY BYTE PIXMAP(BX,BY) * * Draw a straight-line segment from absolute pixel coordinates * (IX0, IY0) to (IX1, IY1). * * Arguments: * ICOL (input): Color index * PIXMAP (input/output): The image data buffer. *----------------------------------------------------------------------- INTEGER IX, IY, IS REAL D BYTE VAL * IF (ICOL.GT.127) THEN VAL = ICOL-256 ELSE VAL = ICOL END IF IF (IX0.EQ.IX1 .AND. IY0.EQ.IY1) THEN PIXMAP(IX0,IY0)=VAL ELSE IF (ABS(IY1-IY0).GT.ABS(IX1-IX0)) THEN D=(IX1-IX0)/REAL(IY1-IY0) IS=1 IF (IY1.LT.IY0) IS=-1 DO 10 IY=IY0,IY1,IS IX=NINT(IX0+(IY-IY0)*D) PIXMAP(IX,IY)=VAL 10 CONTINUE ELSE D=(IY1-IY0)/REAL(IX1-IX0) IS=1 IF (IX1.LT.IX0) IS=-1 DO 20 IX=IX0,IX1,IS IY=NINT(IY0+(IX-IX0)*D) PIXMAP(IX,IY)=VAL 20 CONTINUE END IF END **GRGI03 -- PGPLOT GIF driver, fill rectangle *+ SUBROUTINE GRGI03 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY BYTE PIXMAP(BX,BY) * * Arguments: * IX0, IY0 (input): Lower left corner. * IX1, IY1 (input): Upper right corner. * ICOL (input): Color value. * BX, BY (input): dimensions of PIXMAP. * PIXMAP (input/output): The image data buffer. *----------------------------------------------------------------------- INTEGER IX, IY BYTE VAL C IF (ICOL.GT.127) THEN VAL = ICOL-256 ELSE VAL = ICOL END IF DO 20 IY=IY0,IY1 DO 10 IX=IX0,IX1 PIXMAP(IX,IY) = VAL 10 CONTINUE 20 CONTINUE END **GRGI04 -- PGPLOT GIF driver, fill image line *+ SUBROUTINE GRGI04(NBUF,RBUF,BX,BY,PIXMAP,MAXIDX) INTEGER I,J,NBUF,BX,BY,N,IC,MAXIDX REAL RBUF(NBUF) BYTE PIXMAP(BX,BY) *- I = NINT(RBUF(1))+1 J = BY-NINT(RBUF(2)) DO 10 N=3,NBUF IC=RBUF(N) MAXIDX=MAX(MAXIDX,IC) IF (IC.GT.127) IC = IC-256 PIXMAP(I+N-3,J)=IC 10 CONTINUE END **GRGI06 -- PGPLOT GIF driver, write GIF image *+ SUBROUTINE GRGI06 (UNIT, BX, BY, CTABLE, PIXMAP, MAXIDX, CODE) INTEGER UNIT, BX, BY, MAXIDX INTEGER CTABLE(3,0:255) BYTE PIXMAP(BX * BY) INTEGER*2 CODE(0:4097,0:255) * * Write GIF image to UNIT. * * Arguments: * UNIT (input): Output unit * BX,BY (input): `Screen' size * CTABLE (input): Color map * PIXMAP (input): Image data * MAXIDX (input): maximum color index used. *-- * 16-Nov-94: fixed bug (BYTE is signed) *----------------------------------------------------------------------- CHARACTER GIF1*6, GIF2*7, GIF3*3, GIF4*10 CHARACTER*2 GRGI09 INTEGER BMAX, BMULT, BREST, BOUT INTEGER PIXEL, I, J, K, M, CLEAR, EOI, TABLE, IN, TOTAL, PRE, EXT INTEGER OLDPRE, BITS INTEGER GRWFCH, GRWFIL BYTE BLKOUT(0:254) COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT BITS = 1 10 IF (MAXIDX .LT. 2**BITS) GOTO 20 BITS = BITS + 1 GOTO 10 20 CONTINUE * * Write Header. * GIF1 = 'GIF87a' I = GRWFCH(UNIT, GIF1) IF (I.NE.6) CALL GRWARN ('Error writing GIF header') * * Write Logical Screen Descriptor (screen width, screen height, * color data, background color index [0], pixel aspect ratio [0]). * GIF2(1:2) = GRGI09(BX) GIF2(3:4) = GRGI09(BY) GIF2(5:5) = CHAR(128 + 17 * (BITS - 1)) GIF2(6:6) = CHAR(0) GIF2(7:7) = CHAR(0) I = GRWFCH(UNIT, GIF2) * * Write Global Color Table. * DO 30 J=0,2**BITS-1 GIF3(1:1) = CHAR(CTABLE(1,J)) GIF3(2:2) = CHAR(CTABLE(2,J)) GIF3(3:3) = CHAR(CTABLE(3,J)) I = GRWFCH(UNIT, GIF3) 30 CONTINUE * PIXEL = MAX(BITS, 2) * * Write Image Descriptor. * GIF4(1:1) = ',' GIF4(2:3) = GRGI09(0) GIF4(4:5) = GRGI09(0) GIF4(6:7) = GRGI09(BX) GIF4(8:9) = GRGI09(BY) GIF4(10:10) = CHAR(0) I = GRWFCH(UNIT, GIF4) * * Write Table Based Image Data, in sub-blocks of up to 255 bytes. * I = GRWFCH(UNIT, CHAR(PIXEL)) C C LZW-compression; initialize counters; define clear code and EOI code. C Start packing variable-size codes into 8-bit bytes. C Push a clear code first. C `Read' first character. C DO 100 M=0,255 DO 100 K=0,4095 100 CODE(K,M)=0 CLEAR=2**PIXEL EOI=CLEAR + 1 BREST=0 BOUT=0 BMULT=1 BMAX=CLEAR*2 CALL GRGI07(UNIT, CLEAR) IN=1 TOTAL=BX*BY PRE=PIXMAP(IN) IF (PRE.LT.0) PRE = PRE+256 * * Start new data stream at line 310: * 2**n-1 (n+1)-bit codes * 2*2**n (n+2)-bit codes * 4*2**n (n+3)-bit codes * . . . * 1024 11-bit codes * 2048 12-bit codes (incl. one clear code) * 310 TABLE=EOI BMAX=CLEAR*2 * * `Read' next character; check if combination prefix&extension occurred earlier * 320 IF (IN.GE.TOTAL) GOTO 350 IN=IN+1 EXT=PIXMAP(IN) IF (EXT.LT.0) EXT = EXT+256 OLDPRE=PRE PRE=CODE(PRE,EXT) IF (PRE.GT.0) GOTO 320 * * If no earlier occurrence add combination to table * TABLE=TABLE+1 CALL GRGI07(UNIT, OLDPRE) CODE(OLDPRE,EXT)=TABLE PRE=EXT IF (TABLE.EQ.BMAX) BMAX=BMAX*2 IF (TABLE.LT.4095) GOTO 320 CALL GRGI07(UNIT, CLEAR) DO 330 M=0,255 DO 330 K=0,4095 330 CODE(K,M)=0 GOTO 310 * * Last character * 350 CALL GRGI07(UNIT, PRE) CALL GRGI07(UNIT, EOI) IF (BMULT.GT.1) CALL GRGI08(UNIT, BREST) IF (BOUT.GT.0) THEN IF (BOUT.GT.127) THEN BLKOUT(0) = BOUT-256 ELSE BLKOUT(0) = BOUT END IF I = GRWFIL (UNIT, BOUT+1, BLKOUT(0)) BOUT = 0 END IF BLKOUT(0) = 0 I = GRWFIL (UNIT, 1, BLKOUT(0)) * * Write GIF Trailer. * I = GRWFCH (UNIT, ';') END **GRGI07 -- Compile GIF output code * SUBROUTINE GRGI07(UNIT, INCODE) INTEGER UNIT, INCODE INTEGER BMAX, BMULT, BREST, BOUT BYTE BLKOUT(0:254) COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT C BREST = BREST + BMULT * INCODE BMULT = BMULT * BMAX C 10 IF (BMULT .LT. 256) RETURN CALL GRGI08(UNIT, BREST) BREST = BREST / 256 BMULT = BMULT / 256 GOTO 10 C END **GRGI08 -- Compile and write GIF output buffer * SUBROUTINE GRGI08(UNIT, INCODE) INTEGER UNIT, INCODE, I, J, GRWFIL INTEGER BMAX, BMULT, BREST, BOUT BYTE BLKOUT(0:254) COMMON /GRGICO/ BMAX, BMULT, BREST, BOUT, BLKOUT C BOUT = BOUT + 1 J = MOD(INCODE,256) IF (J.GT.127) J = J-256 BLKOUT(BOUT) = J IF (BOUT .LT. 254) RETURN C! changed 1997-Sep-2 BLKOUT(0) = 254-256 I = GRWFIL(UNIT, 255, BLKOUT(0)) BOUT = 0 END **GRGI09 -- Encode integer in 2-char string * CHARACTER*2 FUNCTION GRGI09(I) INTEGER I INTEGER I1, I2 * I1 = MOD(I,256) I2 = MOD(I/256,256) GRGI09(1:1) = CHAR(I1) GRGI09(2:2) = CHAR(I2) END **GRGI10 -- Replace # in filename by picture number * SUBROUTINE GRGI10 (NAME1, NP, NAME2) CHARACTER*(*) NAME1 CHARACTER*(*) NAME2 CHARACTER*80 TMP INTEGER GRTRIM INTEGER NP, IDX, L, LN LN = GRTRIM(NAME1) IDX = INDEX(NAME1,'#') IF (IDX.GT.0) THEN C -- if the supplied name contains a #-character, replace C it with the page number CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE IF (NP.EQ.1) THEN C -- if this is the first page, use the supplied name NAME2 = NAME1 RETURN ELSE IF (LN+2.LE.LEN(NAME1)) THEN C -- append an underscore and the page number to the supplied C name NAME1(LN+1:LN+2) = '_#' CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE C -- last resort: invent a new name CALL GRFAO('pgplot#.gif', L, TMP, NP, 0, 0, 0) END IF CALL GRWARN ('Writing new GIF image as: '//TMP(:L)) NAME2 = TMP(:L) END --------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. -------------pgplot/drivers/ppdriv.f010064400040640000322000000402150652644143500156760ustar00tjpcitmbr00000400000017C*PPDRIV -- PGPLOT PPM drivers C+ SUBROUTINE PPDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR * * PGPLOT driver for Portable Pixel Map (PPM) files with 'true color' * capability. * * Supported device: PPM (P6) file format * * Device type codes: /PPM or /VPPM * * Default device name: pgplot.ppm. * * If you have more than one image to plot (i.e. use PGPAGE) with this * device, subsequent pages will be named: pgplot2.ppm, pgplot3.ppm, * etc, disrespective of the device name you specified. * You can however bypass this by specifying a device name including a * number sign (#), which will henceforth be replaced by the pagenumber. * Example: page#.ppm will produce files page1.ppm, page2.ppm, etc. * * Default view surface dimensions are: * - PPM : 850 x 680 pixels * - VPPM : 680 x 850 pixels * Default width and height can be overriden by specifying environment * variables * PGPLOT_PPM_WIDTH (default 850) * PGPLOT_PPM_HEIGHT (default 680) * The nominal scale is 85 pixels per inch. * * Color capability: * Indices 0 to 255 are supported. * Default colors for indices 0 to 15 are implemented. * Color representation can be changed with PGSCR; color changes * affect subsequently drawn pixels only, not previously drawn * pixels. Thus the image is not limited to 256 different colors. * * Obtaining hardcopy: Use a PPM viewer or converter. *= * 9-Aug-1993 - Created by Remko Scharroo * 6-Jul-1994 - Adapted to new PGPLOT version 4.9h * 4-Aug-1994 - Use FASTIO. * 9-Aug-1994 - New scheme for line plotting * 16-Aug-1994 - Provide multi-image plotting. * 16-Nov-1994 - Revised (T. Pearson). * 28-Dec-1995 - Prevent concurrent access [TJP]. * 29-Apr-1996 - Use GRCTOI to decode environment variables [TJP]. *----------------------------------------------------------------------- CHARACTER*(*) LTYPE, PTYPE, DEFNAM INTEGER DWD, DHT PARAMETER ( 1 LTYPE= 'PPM (Portable Pixel Map file, landscape orientation)', 2 PTYPE= 'VPPM (Portable Pixel Map file, portrait orientation)') PARAMETER (DEFNAM='pgplot.ppm') PARAMETER (DWD=850, DHT=680) REAL XRES, YRES PARAMETER (XRES=85., YRES=XRES) C INTEGER UNIT, IC, CVAL, CTABLE(3,0:255), IER, I, L, LL, NPICT INTEGER BX, BY, IX0, IY0, IX1, IY1, R, G, B, STATE, USERH, USERW INTEGER CDEFLT(3,0:15), JUNK INTEGER GRGMEM, GRFMEM, GROFIL, GRCFIL, GRCTOI CHARACTER*80 MSG, INSTR, FILENM C C Note: for 64-bit operating systems, change the following C declaration to INTEGER*8: C INTEGER PIXMAP C SAVE UNIT, IC, CVAL, CTABLE, BX, BY, PIXMAP, NPICT, CDEFLT SAVE STATE DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ DATA STATE /0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in PPM device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF (MODE.EQ.1) THEN CHR = LTYPE LCHR = LEN(LTYPE) ELSE IF (MODE.EQ.2) THEN CHR = PTYPE LCHR = LEN(PTYPE) ELSE CALL GRWARN('Requested MODE not implemented in PPM driver') ENDIF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = -1 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = XRES RBUF(2) = YRES RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, supports rectangle fill, pixel C primitives, and query color rep.) C 40 CHR = 'HNNNNRPNYN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = BX-1 RBUF(3) = 0 RBUF(4) = BY-1 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT PPM file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF C -- dimensions of plot buffer USERW = 0 USERH = 0 CALL GRGENV('PPM_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) USERW = GRCTOI(INSTR(:L),LL) CALL GRGENV('PPM_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) USERH = GRCTOI(INSTR(:L),LL) IF (MODE.EQ.1) THEN * -- Landscape BX = DWD IF (USERW.GE.8) BX = USERW BY = DHT IF (USERH.GE.8) BY = USERH ELSE * -- Portrait BX = DHT IF (USERH.GE.8) BX = USERH BY = DWD IF (USERW.GE.8) BY = USERW END IF NPICT=1 * -- Initialize color table DO 95 I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) 95 CONTINUE DO 96 I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 96 CONTINUE * FILENM = CHR(:LCHR) CALL GRPP10 (FILENM, NPICT, MSG) UNIT = GROFIL (MSG) RBUF(1) = UNIT IF (UNIT.LT.0) THEN CALL GRWARN('Cannot open output file for PPM plot') RBUF(2) = 0 ELSE RBUF(2) = 1 STATE = 1 END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE STATE = 0 RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE BX = NINT(RBUF(1))+1 BY = NINT(RBUF(2))+1 C -- allocate buffer with 4 bytes per pixel IER = GRGMEM(4*BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') BX = 0 BY = 0 PIXMAP = 0 END IF C -- initialize to zero (background color) IF (PIXMAP.NE.0) : CALL GRPP03(1, 1, BX, BY, 0, BX, BY, %VAL(PIXMAP)) C -- open new file if necessary IF (NPICT.GT.1) THEN CALL GRPP10 (FILENM, NPICT, MSG) UNIT = GROFIL (MSG) IF (UNIT.LT.0) : CALL GRWARN('Cannot open output file for PPM plot') C -- no way to return error status! END IF RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY0=BY-NINT(RBUF(2)) IY1=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRPP01(IX0, IY0, IX1, IY1, CVAL, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IX0=NINT(RBUF(1))+1 IY0=BY-NINT(RBUF(2)) IF (PIXMAP.NE.0) : CALL GRPP01(IX0, IY0, IX0, IY0, CVAL, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE IF (PIXMAP.NE.0) THEN CALL GRPP02(UNIT, BX, BY, %VAL(PIXMAP)) IF (UNIT.GE.0) JUNK = GRCFIL(UNIT) NPICT = NPICT+1 IER = GRFMEM(4*BX*BY, PIXMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF END IF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = NINT(RBUF(1)) IF (IC.LT.0 .OR. IC.GT.255) IC = 1 R = CTABLE(1,IC) G = CTABLE(2,IC) B = CTABLE(3,IC) CVAL = R + 256*(G + 256*B) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE I = NINT(RBUF(1)) IF (I.GE.0 .AND. I.LE.255) THEN CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill ------------------------------------------ C 240 CONTINUE IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY1=BY-NINT(RBUF(2)) IY0=BY-NINT(RBUF(4)) IF (PIXMAP.NE.0) : CALL GRPP03(IX0, IY0, IX1, IY1, CVAL, BX, BY, %VAL(PIXMAP)) RETURN C C--- IFUNC=25, Not implemented ----------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE IF (PIXMAP.NE.0) : CALL GRPP04(NBUF, RBUF, BX, BY, %VAL(PIXMAP), CTABLE) RETURN C C--- IFUNC=27, Not implemented ----------------------------------------- C 270 CONTINUE RETURN C C--- IFUNC=28, Not implemented ----------------------------------------- C 280 CONTINUE RETURN C C--- IFUNC=29, Query color representation. ----------------------------- C 290 CONTINUE I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END **GRPP01 -- PGPLOT PPM driver, draw line *+ SUBROUTINE GRPP01 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY, PIXMAP(BX,BY) * * Draw a straight-line segment from absolute pixel coordinates * (IX0, IY0) to (IX1, IY1). * * Arguments: * IX0, IY0 (input): Starting point of line. * IX1, IY1 (input): End point of line. * ICOL (input): Color value. * BX, BY (input): dimensions of PIXMAP. * PIXMAP (input/output): The image data buffer. *- * 9-Aug-1994 - Recreated by Remko Scharroo from GRGI01 by Ge van Geldorp * Improved algorithm. *----------------------------------------------------------------------- INTEGER IX, IY, IS REAL D C IF (IX0.EQ.IX1 .AND. IY0.EQ.IY1) THEN PIXMAP(IX0,IY0)=ICOL ELSE IF (ABS(IY1-IY0).GT.ABS(IX1-IX0)) THEN D=(IX1-IX0)/REAL(IY1-IY0) IS=1 IF (IY1.LT.IY0) IS=-1 DO 10 IY=IY0,IY1,IS IX=NINT(IX0+(IY-IY0)*D) PIXMAP(IX,IY)=ICOL 10 CONTINUE ELSE D=(IY1-IY0)/REAL(IX1-IX0) IS=1 IF (IX1.LT.IX0) IS=-1 DO 20 IX=IX0,IX1,IS IY=NINT(IY0+(IX-IX0)*D) PIXMAP(IX,IY)=ICOL 20 CONTINUE ENDIF END **GRPP02 -- PGPLOT PPM driver, write PPM image *+ SUBROUTINE GRPP02 (UNIT, BX, BY, PIXMAP) INTEGER UNIT, BX, BY, PIXMAP(*) * * This routine copies the image buffer to an output buffer. A PPM image * header and the output buffer are written to UNIT. * * Arguments: * UNIT (input): Output unit * BX, BY (input): Image size * PIXMAP (input): Image data *- * 10-Aug-1993 - Created by Remko Scharroo * 16-Nov-1994 - Rewritten by T. Pearson *----------------------------------------------------------------------- * BUFSIZ must be a multiple of 3 (and not larger than 500 for * portability to AIX) INTEGER BUFSIZ PARAMETER (BUFSIZ=498) INTEGER I, N, IER, IBUF, L1, L2 INTEGER GRTRIM, GRWFCH CHARACTER*128 HEAD CHARACTER*20 USER CHARACTER*20 TODAY CHARACTER*(BUFSIZ) BUF LOGICAL BAD * * Write the header (magic number = P6) * CALL GRUSER(USER,L1) CALL GRDATE(TODAY,L2) WRITE (HEAD, 1000) USER(:L1), TODAY(:L2),CHAR(10), : BX, BY, CHAR(10), 255, CHAR(10) 1000 FORMAT ('P6 # PGPLOT PPM image ',A,1X,A,A1, I5,1X,I5,A1, I3,A1) N = GRTRIM(HEAD) IER = GRWFCH(UNIT, HEAD(1:N)) IF (IER.NE.N) CALL GRWARN('Failed writing PPM header') * * Write the pixel data as R,G,B components * N=BX*BY IBUF=0 BAD = .FALSE. DO 10 I=1,N BUF(IBUF+1:IBUF+1) = CHAR(MOD(PIXMAP(I),256)) BUF(IBUF+2:IBUF+2) = CHAR(MOD(PIXMAP(I)/256,256)) BUF(IBUF+3:IBUF+3) = CHAR(PIXMAP(I)/(256*256)) IBUF = IBUF+3 IF (IBUF.GE.BUFSIZ) THEN IER = GRWFCH(UNIT, BUF) IF (IER.NE.IBUF) BAD = .TRUE. IBUF = 0 END IF 10 CONTINUE IF (IBUF.GT.0) THEN IER = GRWFCH(UNIT, BUF(:IBUF)) IF (IER.NE.IBUF) BAD = .TRUE. IBUF = 0 END IF IF (BAD) CALL GRWARN('Failed writing PPM data') END **GRPP03 -- PGPLOT PPM driver, fill rectangle *+ SUBROUTINE GRPP03 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY, PIXMAP(BX,BY) * * Arguments: * IX0, IY0 (input): Lower left corner. * IX1, IY1 (input): Upper right corner. * ICOL (input): Color value. * BX, BY (input): dimensions of PIXMAP. * PIXMAP (input/output): The image data buffer. *----------------------------------------------------------------------- INTEGER IX, IY C DO 20 IY=IY0,IY1 DO 10 IX=IX0,IX1 PIXMAP(IX,IY) = ICOL 10 CONTINUE 20 CONTINUE END **GRPP04 -- PGPLOT PPM driver, fill image line *+ SUBROUTINE GRPP04(NBUF,RBUF,BX,BY,PIXMAP,CTABLE) INTEGER I,J,NBUF,BX,BY,N,IC REAL RBUF(NBUF) INTEGER PIXMAP(BX,BY) INTEGER CTABLE(3,0:255) INTEGER R, G, B *- I = NINT(RBUF(1))+1 J = BY-NINT(RBUF(2)) DO 10 N=3,NBUF IC=RBUF(N) R = CTABLE(1,IC) G = CTABLE(2,IC) B = CTABLE(3,IC) PIXMAP(I+N-3,J) = R + 256*(G + 256*B) 10 CONTINUE END **GRPP10 -- Replace # in filename by picture number * SUBROUTINE GRPP10 (NAME1, NP, NAME2) CHARACTER*(*) NAME1 CHARACTER*(*) NAME2 CHARACTER*80 TMP INTEGER GRTRIM INTEGER NP, IDX, L, LN LN = GRTRIM(NAME1) IDX = INDEX(NAME1,'#') IF (IDX.GT.0) THEN C -- if the supplied name contains a #-character, replace C it with the page number CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE IF (NP.EQ.1) THEN C -- if this is the first page, use the supplied name NAME2 = NAME1 RETURN ELSE IF (LN+2.LE.LEN(NAME1)) THEN C -- append an underscore and the page number to the supplied C name NAME1(LN+1:LN+2) = '_#' CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE C -- last resort: invent a new name CALL GRFAO('pgplot#.ppm', L, TMP, NP, 0, 0, 0) END IF CALL GRWARN ('Writing new PPM image as: '//TMP(:L)) NAME2 = TMP(:L) END CALL GRWARN('Cannot open output file for PPM plot') RBUF(2) = 0 ELSE RBUF(2) = 1 STATE = 1 END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE STATE = 0 RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE pgplot/drivers/bcdriv.f010064400040640000322000000275770641626611700156630ustar00tjpcitmbr00000400000017 SUBROUTINE BCDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Canon Laser printer. C--- C This driver produces a bitmap that then can be printed on the C Canon. The default size is 1556 blocks and takes 5 min C (parallel) or 15 min (serial 9600 baud) to print. Thus for C simple line graphs CADRIVER produces much smaller files C (typically <100 blocks) that that plot in <30 sec. However, for C complex graphs, for example those obtained with PGGRAY, BCDRIVER C will produce the smaller file and plot faster. Therefore, it is C suggested that sites with Canon laser printers should support C both drivers. C--- C Supported device: Canon LBP-8/A2 Laser printer. C Conforms to ISO646,2022,2375 and 6429 specifications. C VDM (graphics) conforms to proposed American National C Standard VDM mode. C C Device type code: /BCanon (landscape mode only). C C Default file name: PGPLOT.CAN C C Default view surface dimensions: 24 cm by 19 cm. C Resolution: 300 pixels per inch in both directions. C C Color capability: Color indices 0 (erase) and 1 (black) are C supported. Note, hardware polygon fill is used and colors C 0-11 control the fill pattern. C C Input capability: None. C C File format: Variable length records with Carriage control C of LIST. C C Obtaining hardcopy: If printer is connected to a terminal C line (RS-232 option) then printing the file on the corresponding C queue should suffice. If the printer is connected using C the Centronics interface that appears the to VAX as an C LP device then it is important to ensure that (1) all 8 bit C characters are passed to the printer (2) lines longer than C 132 bytes are not truncated, and (3) no extra formatting C commands (e.g. form-feeds) are sent to the printer. C This can be done with the VMS command: C $ SET PRINT/PASSALL/LOWER/CR C Note, some interface boards have a option to append a carriage C return after a formfeed or LF character, it is necessary C that this be disabled. C The file should be printed with the /PASSALL qualifier i.e., C $ PRINT/PASSALL C Note, SET PRINT/PASSALL and PRINT/PASSALL do not do the C same things and hence PASSALL is required in both locations. C--- C 13-Mar-1987 - [AFT]. C 4-MAR-1988 - Tidy code [AFT] C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE= : 'BCANON (Canon laser printer, bitmap mode, landscape)') CHARACTER MSG*10 INTEGER GRGMEM, GRFMEM INTEGER LUN, IXDIM, IYDIM, LENBUF, IBADR, IER INTEGER ICOL, IREC, LENOLD SAVE LUN, IXDIM, IYDIM, LENBUF, IBADR, IER SAVE ICOL, IREC, LENOLD DATA LENOLD/0/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, > 110,120,130,140,150,160,900,180) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in BC device driver: '//MSG) NBUF=-1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR=TYPE LCHR=LEN(TYPE) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=3320 RBUF(3)=0 RBUF(4)=2335 RBUF(5)=0 RBUF(6)=1 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=300.0 RBUF(2)=300.0 RBUF(3)=1 NBUF=3 LCHR=LEN(CHR) RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- C H= Hardcopy C N= No cursor C N= No hard dash C N= No area fill C N= No hard thick lines 40 CHR='HNNNNNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='PGPLOT.CAN' LCHR=LEN(CHR) RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=2834 RBUF(3)=0 RBUF(4)=2244 RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 CALL GRGLUN(LUN) OPEN(UNIT=LUN,FILE=CHR(:LCHR),STATUS='NEW',ACCESS='DIRECT', > RECL=128,IOSTAT=IER) IF(IER.NE.0) THEN CALL GRWARN('Cannot open graphics device '//CHR(:LCHR)) RBUF(1)=LUN RBUF(2)=0 CALL GRFLUN(LUN) ELSE RBUF(1)=0 RBUF(2)=1 END IF IREC=0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN(LUN) IF(LENOLD.GT.0) THEN IER=GRFMEM(LENBUF, IBADR) IF(IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') RETURN END IF LENOLD=0 END IF RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ C- Note, IXMIN=0 and IXMAX=RBUF(1) so, IXDIM=IXMAX-IXMIN+1=RBUF(1)+1 110 IXDIM=RBUF(1)+1 IYDIM=INT(RBUF(2)/8.)+1 LENBUF=IXDIM*IYDIM IF(LENBUF.NE.LENOLD) THEN IF(LENOLD.GT.0) THEN IER=GRFMEM(LENOLD, IBADR) IF(IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') RETURN END IF END IF IER=GRGMEM(LENBUF, IBADR) IF(IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RETURN END IF CALL GRBC05(LENBUF,%val(IBADR)) LENOLD=LENBUF END IF RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 CALL GRBC01(1,RBUF,ICOL,IYDIM,%val(IBADR)) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 CALL GRBC01(0,RBUF,ICOL,IYDIM,%val(IBADR)) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 CALL GRBC04(LUN,IREC,%val(IBADR),IXDIM,IYDIM) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C- Save pen number (up to 11) for possible use in pattern interior. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),11)) RBUF(1)=MAX(0,MIN(ICOL,1)) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C----------------------------------------------------------------------- END SUBROUTINE GRBC01(LINE,RBUF,ICOL,IXDIM,QXYBUF) C----------------------------------------------------------------------- C GRPCKG (internal routine, Bitmap Canon): draw a (visible) C straight line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). This routine is called by basic plotting C routines GRDOT0 and GRLIN2. C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C IXDIM I I First array dimension of the frame buffer C -considered as a two-dimensional byte array. C QXYBUF I/O B (address of) the frame buffer. C C 13-Mar-1987 - Copied from GRVE01 routine for use with GEDRIVER [AFT]. C----------------------------------------------------------------------- BYTE QXYBUF(0:*), QMASK(0:7) REAL RBUF(4) INTEGER LINE, ICOL, IXDIM, LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'80'x,'40'x,'20'x,'10'x,'08'x,'04'x,'02'x,'01'x/ C IF(LINE.GT.0) THEN LENGTH=NINT(MAX(ABS(RBUF(3)-RBUF(1)),ABS(RBUF(4)-RBUF(2)))) D=MAX(1,LENGTH) XINC=(RBUF(3)-RBUF(1))/D YINC=(RBUF(4)-RBUF(2))/D ELSE LENGTH=0 XINC=0. YINC=0. END IF XP=RBUF(1) YP=RBUF(2) IF (ICOL.GT.0) THEN DO K=0,LENGTH KX=NINT(XP) KY=NINT(YP) QXYBUF(KX*IXDIM+KY/8)= > QXYBUF(KX*IXDIM+KY/8).OR.QMASK(MOD(KY,8)) XP=XP+XINC YP=YP+YINC END DO ELSE DO K=0,LENGTH KX=NINT(XP) KY=NINT(YP) QXYBUF(KX*IXDIM+KY/8)= > QXYBUF(KX*IXDIM+KY/8).AND.(.NOT.QMASK(MOD(KY,8))) XP=XP+XINC YP=YP+YINC END DO END IF RETURN END SUBROUTINE GRBC04(LUN,IREC,QBUF,IXDIM,IYDIM) C----------------------------------------------------------------------- C GRPCKG internal routine for Canon laser printer. C Dumps bitmap to file, clearing bitmap. C----------------------------------------------------------------------- INTEGER IESC, ICSI PARAMETER (IESC=27, ICSI=155) INTEGER LUN, IREC, IXDIM, IYDIM BYTE QBUF(*) INTEGER LENBUF, ITMP, I, JC CHARACTER CREC*512, CTMP*16 BYTE QREC(512) EQUIVALENCE (QREC,CREC) C--- JC=0 C- First record, reset printer, set to ISO mode. CREC(JC+1:JC+6)=CHAR(IESC)//';'//CHAR(IESC)//'c'// : CHAR(IESC)//';' JC=JC+6 LENBUF=IXDIM*IYDIM C- Work out absolute vertical position. ITMP=1+(3320-IXDIM)/100 ITMP=MIN(ITMP,5) IF(ITMP.GT.1) THEN CREC(JC+1:JC+1)=CHAR(ICSI) JC=JC+1 WRITE(CTMP,101) ITMP 101 FORMAT(I16) DO I=1,LEN(CTMP) IF(CTMP(I:I).NE.' ') THEN JC=JC+1 CREC(JC:JC)=CTMP(I:I) END IF END DO CREC(JC+1:JC+1)='d' JC=JC+1 END IF C- Work out absolute horizontal position. ITMP=1+(2400-IYDIM*8)/60 ITMP=MIN(ITMP,4) IF(ITMP.GT.1) THEN CREC(JC+1:JC+1)=CHAR(ICSI) JC=JC+1 WRITE(CTMP,101) ITMP DO I=1,LEN(CTMP) IF(CTMP(I:I).NE.' ') THEN JC=JC+1 CREC(JC:JC)=CTMP(I:I) END IF END DO CREC(JC+1:JC+1)='`' JC=JC+1 END IF C- Drawing box command. CREC(JC+1:JC+1)=CHAR(ICSI) JC=JC+1 WRITE(CTMP,101) LENBUF DO I=1,LEN(CTMP) IF(CTMP(I:I).NE.' ') THEN JC=JC+1 CREC(JC:JC)=CTMP(I:I) END IF END DO JC=JC+1 CREC(JC:JC)=';' WRITE(CTMP,101) IYDIM DO I=1,LEN(CTMP) IF(CTMP(I:I).NE.' ') THEN JC=JC+1 CREC(JC:JC)=CTMP(I:I) END IF END DO CREC(JC+1:JC+6)=';300.r' JC=JC+6 C- Send binary data. DO I=1,LENBUF JC=JC+1 QREC(JC)=QBUF(I) QBUF(I)=0 IF(JC.EQ.512) THEN IREC=IREC+1 WRITE(LUN,REC=IREC) QREC JC=0 END IF END DO C- Dump last record, if necessary. IF(JC.NE.0) THEN DO I=JC+1,512 QREC(I)=0 END DO IREC=IREC+1 WRITE(LUN,REC=IREC) QREC END IF RETURN END C*GRBC05 -- zero fill buffer C+ SUBROUTINE GRBC05 (BUFSIZ,BUFFER) C C GRPCKG (internal routine): fill a buffer with a given character. C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL /0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END pgplot/drivers/cadriv.f010064400040640000322000000302420641626700600156370ustar00tjpcitmbr00000400000017 SUBROUTINE CADRIV(IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Canon Laser printer. C C Supported device: Canon LBP-8/A2 Laser printer. C Conforms to ISO646,2022,2375 and 6429 specifications. C VDM (graphics) conforms to proposed American National C Standard VDM mode. C C Device type code: /CAnon (landscape mode only). C C Default file name: PGPLOT.CAN C C Default view surface dimensions: 24 cm by 19 cm. C C Resolution: 300 pixels per inch in both directions. C C Color capability: Color indices 0 (erase) and 1 (black) are C supported. Note, hardware polygon fill is used and colors C 0-11 control the fill pattern. C C Input capability: None. C C File format: Variable length records with Carriage control C of LIST. C C Obtaining hardcopy: If printer is connected to a terminal C line (RS-232 option) then printing the file on the corresponding C queue should suffice. If the printer is connected using C the Centronics interface, which appears the to VAX as an C LP device, then it is important to ensure that (1) all 8 bit C characters are passed to the printer (2) lines longer than C 132 bytes are not truncated, and (3) no extra formatting C commands (e.g. form-feeds) are sent to the printer. C This can be done with the VMS command: C $ SET PRINT/PASSALL/LOWER/CR C Note, some interface boards have a option to append a carriage C return after a formfeed or LF character, it is suggested C that this be disabled. C The file should be printed with the /PASSALL qualifier i.e., C $ PRINT/PASSALL C Note, SET PRINT/PASSALL and PRINT/PASSALL do not do the C same things and hence PASSALL is required in both locations. C C 27-Jan-1988 - Version can be sent over BITNET (I hope) [AFT]. C 27-Sep-1986 - Add color index 0 (erase) [AFT]. C 5-Aug-1986 - [AFT]. C 13-Nov-1991 - [MCS] Having corrected unit scale factor to be one dot C instead of 0.8mm in GRCA03, changed viewport dimensions C to appear the same as before. C 14-Nov-1991 - [MCS] 11 colour indexes are already implemented as fill C patterns - however device info on this said there were C only 0 and 1 - corrected IFUNC 2 now reports 11 colours C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='CANON (Canon LBP-8/A2 Laser printer, landscape)') INTEGER IS2, IVESC PARAMETER (IS2=30, IVESC=125) C- The maximum physical size of the plot in units of 1/300 inch. INTEGER MXLEN, MXWID PARAMETER (MXLEN=3366, MXWID=2362) C- Default size of plot. INTEGER IDEFL, IDEFW PARAMETER (IDEFL=2835, IDEFW=2244) C CHARACTER CBUF*256 CHARACTER MSG*10 CHARACTER CDASH(5),CFILL(0:11) INTEGER I0, J0, I1, J1, IER INTEGER LUN, ICOL, NPTS, LBUF, LASX, LASY SAVE LUN, ICOL, NPTS, LBUF, LASX, LASY C--- C- Patterns defined with 2 and " appear the same on our Canon C- so only one is used. Pattern 0 causes the polygon not to C- be filled. Pattern ) erases interior of polygon is the C- last character in list as all colors > max are set to C- this pattern. DATA CFILL/')','1','(','''','&','%', : '$','2','#','!','0',')'/ DATA CDASH/'0','1','3','"','4'/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, : 110,120,130,140,150,160,900,180,190,200, : 210) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in CA device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR=TYPE LCHR=LEN(TYPE) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=MXLEN RBUF(3)=0 RBUF(4)=MXWID RBUF(5)=0 RBUF(6)=11 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=300.0 RBUF(2)=300.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- 40 CHR='HNNANNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='PGPLOT.CAN' LCHR=10 RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=IDEFL RBUF(3)=0 RBUF(4)=IDEFW RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 CALL GRGLUN (LUN) OPEN (UNIT=LUN, FILE=CHR(:LCHR), STATUS='NEW', : FORM='FORMATTED', : RECL=512, IOSTAT=IER) IF (IER.EQ.0) THEN RBUF(2)=1 ELSE RBUF(2) = IER ENDIF RBUF(1)=LUN RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN (LUN) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 CALL GRCA03(LUN,1) C- Use the origin transfer command to ensure that the picture is C- centered on the page. I0=(MXLEN-NINT(RBUF(1)))/2 J0=(MXWID-NINT(RBUF(2)))/2 CBUF(1:2)=CHAR(IVESC)//'"' LBUF=2 CALL GRCA04(J0,CBUF,LBUF) CALL GRCA04(I0,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRCA01(LUN,I0,J0,I1,J1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRCA01(LUN,I0,J0,I0,J0) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 CALL GRCA03(LUN,2) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C- Save pen number (up to 11) for possible use in pattern interior. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),11)) RBUF(1)=MAX(0,MIN(ICOL,1)) IF(ICOL.EQ.0) THEN CBUF(1:4)=CHAR(IVESC)//'G2'//CHAR(IS2) ELSE CBUF(1:4)=CHAR(IVESC)//'G0'//CHAR(IS2) END IF WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C- Currently turned off, since pattern is reset at beginning of C- every new line segment. Note, if GRCA01 was modified to C- properly use polylines then dash pattern may work better. 190 CBUF(1:4)='E1'//CDASH(NINT(RBUF(1)))//CHAR(IS2) WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- 200 IF(NPTS.EQ.0) THEN NPTS=RBUF(1) CBUF(1:5)='I'//CFILL(ICOL)//'0'//CHAR(IS2)//'2' LBUF=5 LASX=0 LASY=0 ELSE NPTS=NPTS-1 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRCA04(J0-LASY,CBUF,LBUF) CALL GRCA04(I0-LASX,CBUF,LBUF) LASX=I0 LASY=J0 IF(NPTS.EQ.0) THEN LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) 11 FORMAT(A) LBUF=0 END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C- (not possible but can be called). 210 RETURN C----------------------------------------------------------------------- END SUBROUTINE GRCA01 (LUN,I0,J0,I1,J1) C----------------------------------------------------------------------- C Canon device driver support routine. Draws a line segment. C Current routine plots end line segment as a separate polyline. C This can be improved. C C I0,J0 I I The coordinate of the start point. C I1,J1 I I The coordinate of the end point. C C 26-JUN-86 - [AFT] C----------------------------------------------------------------------- INTEGER IS2 PARAMETER (IS2=30) INTEGER LUN, I0, J0, I1, J1 INTEGER LBUF, IX, IY CHARACTER CBUF*64 C--- CBUF(1:1)='1' LBUF=1 CALL GRCA04(J0,CBUF,LBUF) CALL GRCA04(I0,CBUF,LBUF) IX=I1-I0 IY=J1-J0 CALL GRCA04(IY,CBUF,LBUF) CALL GRCA04(IX,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(1:LBUF) 11 FORMAT(A) RETURN END C********* SUBROUTINE GRCA03(LUN,ICMD) C----------------------------------------------------------------------- C Canon device driver support routine. Outputs to LUN the string C that begins a new picture (ICMD=1) or ends the current picture (ICMD=2). C C- LUN I I Logical unit of output file. C- ICMD I I =1 to begin plot, =2 to terminate plot. C C 26-Jun-1986 - [AFT] C 18-Jan-1988 - Change close brace to CHAR(125) [AFT] C 13-Nov-1991 - [MCS, Jodrell Bank, England] Noticed aliasing when C modified PGGRAY stipple pattern to be sinusoidal. C Error traced to scale factor set at 0.8mm C instead of 1 dot => 1/300 = 0.84667mm corrected by C specifying scale factor in integral dots. C----------------------------------------------------------------------- INTEGER IESC, IS2 PARAMETER (IESC=27, IS2=30) INTEGER LUN,ICMD CHARACTER CBUF*32 C--- 11 FORMAT(A) C--- IF(ICMD.EQ.1) THEN C- Go to ISO mode (ignored if in ISO mode already), Hard reset, C- and then go to ISO again (in case dip switches set to Diablo). CBUF( 1: 4)=CHAR(IESC)//';'//CHAR(IESC)//'c' CBUF( 5: 6)=CHAR(IESC)//';' C- Enable full paint mode. CBUF( 7:10)=CHAR(155)//'2&z' C- Go to vector mode. CBUF(11:13)=CHAR(155)//'&'//CHAR(125) C- Begin picture CBUF(14:21)='#PGPLOT'//CHAR(IS2) C- Scaling mode 1 pixel, Begin picture body. CBUF(22:28)='!0#1'//CHAR(IS2)//'$'//CHAR(IS2) WRITE(LUN,11) CBUF(1:28) ELSE IF(ICMD.EQ.2) THEN C- End picture, Return to text (0,0) CBUF(1:7)='%'//CHAR(IS2)//CHAR(125)//'p00'//CHAR(IS2) WRITE(LUN,11) CBUF(1: 7) END IF RETURN END C********* SUBROUTINE GRCA04(NUM,CBUF,LBUF) C----------------------------------------------------------------------- C Canon device driver support routine. Converts an integer into C the form used by the Canon Laser printer. C C- NUM I I Integer to be converted. C- CBUF I/O C* Buffer string C- LBUF I/O I Number of characters used in CBUF. C C 26-Jun-86 - [AFT] C----------------------------------------------------------------------- CHARACTER CBUF*(*) INTEGER NUM, LBUF INTEGER ITMP, IS, IC CHARACTER CTMP*5 C--- ITMP=NUM C- Bit 4(=16) is set for positive numbers and clear for negative. IS=16 IF(ITMP.LT.0) THEN IS=0 ITMP=-ITMP END IF C- Bits 6+7(=64,128) clear and Bit 5(=32) set, flags that this C- is the last byte in the number. CTMP(5:5)=CHAR(32+IS+IAND(ITMP,15)) ITMP=ITMP/16 IC=1 IF(ITMP.EQ.0) THEN C- Numbers in the range -15 to +15 can be sent in one byte. CBUF(LBUF+1:LBUF+1)=CTMP(5:5) ELSE C- Larger numbers require more bytes and are recorded 6 bits C- per byte with bit 7=(128) clear and bit 6(=64) set. 150 CTMP(5-IC:5-IC)=CHAR(64+IAND(ITMP,63)) IC=IC+1 ITMP=ITMP/64 IF(ITMP.NE.0) GOTO 150 CBUF(LBUF+1:LBUF+IC)=CTMP(6-IC:5) END IF LBUF=LBUF+IC RETURN END patterns - however device info on this said there were C only 0 and 1 - corrected IFUNC 2 now reports 11 colours C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='CANON (Canon LBP-8/A2 Laser printer, landscape)') INTEGER IS2, IVESC PARAMETER (IS2=pgplot/drivers/ccdriv.f010064400040640000322000000525030641627001500156370ustar00tjpcitmbr00000400000017C*CCDRIV -- PGPLOT DEC LJ250 Color Companion driver C+ SUBROUTINE CCDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for DEC LJ250 Color Companion device. C C Version 1.0 - 1989 Jun 04 - S. C. Allendorf C======================================================================= C C Supported device: DEC LJ250 Color Companion printer. C C Device type code: /CCP (portrait) or /CCL (landscape). C C Default device name: PGPLOT.CCPLT. C C Default view surface dimensions: 8.0 inches by 10.5 inches. C C Resolution: 90 dots/inch. C C Color capability: Color indices 0-15 are supported. It is not (yet) C possible to change color representation. C C Input capability: None. C C File format: DEC color sixel format. C C Obtaining hardcopy: Use the VMS PRINT command. C----------------------------------------------------------------------- C C To choose portrait mode, you must execute a DCL command of the C following form before executing your program: C C $ DEFINE PGPLOT_CC_MODE PORTRAIT C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='CC (DEC LJ250 Color Companion printer)') BYTE CTAB(3, 256), FF LOGICAL HIRES, INIT, LANDSCAPE INTEGER*4 BUFFER, BX, BY, I, IC, IER, GRFMEM, GRGMEM INTEGER*4 LUN, MAXCOL, NPICT REAL*4 XBUF(4) CHARACTER DEFNAM*12, MODE*20, MSG*10 PARAMETER (FF = 12) PARAMETER (DEFNAM = 'PGPLOT.CCPLT') DATA INIT /.TRUE./ DATA CTAB /100, 100, 100, 0, 0, 0, 100, 0, 0, 1 0, 100, 0, 0, 0, 100, 0, 100, 100, 2 100, 0, 100, 100, 100, 0, 100, 50, 0, 3 50, 100, 0, 0, 100, 50, 0, 50, 100, 4 50, 0, 100, 100, 0, 50, 33, 33, 33, 5 67, 67, 67, 720 * 0/ C----------------------------------------------------------------------- C First time, do some one-time C initialization. IF (INIT) THEN C Make sure we only do this once. INIT = .FALSE. C Initialize the maximum color C index currently used. MAXCOL = 0 C The default is low resolution, C landscape orientation. LANDSCAPE = .TRUE. HIRES = .FALSE. C Select mode based on logical. CALL GRGENV ('CC_MODE', MODE, I) IF (MODE(1:1) .EQ. 'P') LANDSCAPE = .FALSE. IF (MODE(2:2) .EQ. 'H') HIRES = .TRUE. END IF C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in LJ250 device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE CHR = TYPE NBUF = 0 LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 IF (HIRES .AND. LANDSCAPE) RBUF(2) = 1889.0 IF (HIRES .AND. .NOT. LANDSCAPE) RBUF(2) = 1439.0 IF (.NOT. HIRES .AND. LANDSCAPE) RBUF(2) = 944.0 IF (.NOT. HIRES .AND. .NOT. LANDSCAPE) RBUF(2) = 719.0 RBUF(3) = 0.0 IF (HIRES .AND. LANDSCAPE) RBUF(4) = 1439.0 IF (HIRES .AND. .NOT. LANDSCAPE) RBUF(4) = 1889.0 IF (.NOT. HIRES .AND. LANDSCAPE) RBUF(4) = 719.0 IF (.NOT. HIRES .AND. .NOT. LANDSCAPE) RBUF(4) = 944.0 RBUF(5) = 0.0 IF (HIRES) THEN RBUF(6) = 7.0 ELSE RBUF(6) = 255.0 END IF NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE IF (HIRES) THEN RBUF(1) = 180.0 ELSE RBUF(1) = 90.0 END IF RBUF(2) = RBUF(1) RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CONTINUE CHR = 'HNNNNNNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = DEFNAM NBUF = 0 LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 IF (HIRES .AND. LANDSCAPE) RBUF(2) = 1889.0 IF (HIRES .AND. .NOT. LANDSCAPE) RBUF(2) = 1439.0 IF (.NOT. HIRES .AND. LANDSCAPE) RBUF(2) = 944.0 IF (.NOT. HIRES .AND. .NOT. LANDSCAPE) RBUF(2) = 719.0 RBUF(3) = 0.0 IF (HIRES .AND. LANDSCAPE) RBUF(4) = 1439.0 IF (HIRES .AND. .NOT. LANDSCAPE) RBUF(4) = 1889.0 IF (.NOT. HIRES .AND. LANDSCAPE) RBUF(4) = 719.0 IF (.NOT. HIRES .AND. .NOT. LANDSCAPE) RBUF(4) = 944.0 NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE RBUF(1) = 1.0 NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C Obtain a logical unit number. CALL GRGLUN (LUN) C Check for an error. IF (LUN .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit.') RBUF(2) = 0 RETURN ELSE RBUF(1) = LUN END IF C Open the output file. OPEN (UNIT = LUN, FILE = CHR(:LCHR), CARRIAGECONTROL = 'NONE', 1 DEFAULTFILE = DEFNAM, STATUS = 'NEW', 2 RECL = 362, FORM = 'UNFORMATTED', RECORDTYPE = 'VARIABLE', 3 IOSTAT = IER) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for LJ250 plot: ' // 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN (LUN) RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN, NAME = CHR) LCHR = LEN (CHR) 91 IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 91 END IF END IF C Initialize the page counter. NPICT = 0 RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE C Close the file. CLOSE (LUN, STATUS = 'KEEP') C Deallocate the logical unit. CALL GRFLUN (LUN) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Calculate the dimensions of the C plot buffer. IF (LANDSCAPE) THEN XBUF(1) = RBUF(2) XBUF(2) = RBUF(1) ELSE XBUF(1) = RBUF(1) XBUF(2) = RBUF(2) END IF BX = INT (XBUF(1)) + 1 BY = (INT (XBUF(2)) / 6 + 1) * 6 C Allocate a plot buffer. IER = GRGMEM (BX * BY, BUFFER) C Check for error and clean up C if one was found. IF (IER .NE. 1) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate a plot buffer.') END IF C Increment the page number. NPICT = NPICT + 1 C Eject the page from the printer. IF (NPICT .GT. 1) WRITE (LUN) FF C Zero out the plot buffer. CALL GRCC04 (BX * BY, %VAL(BUFFER)) RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Apply any needed tranformation. IF (LANDSCAPE) THEN XBUF(1) = RBUF(2) XBUF(2) = (BY - 1) - RBUF(1) XBUF(3) = RBUF(4) XBUF(4) = (BY - 1) - RBUF(3) ELSE XBUF(1) = RBUF(1) XBUF(2) = RBUF(2) XBUF(3) = RBUF(3) XBUF(4) = RBUF(4) END IF C Draw the point into the bitmap. CALL GRCC00 (1, XBUF, IC, BX, BY, %VAL (BUFFER)) RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Apply any needed tranformation. IF (LANDSCAPE) THEN XBUF(1) = RBUF(2) XBUF(2) = (BY - 1) - RBUF(1) ELSE XBUF(1) = RBUF(1) XBUF(2) = RBUF(2) END IF C Draw the point into the bitmap. CALL GRCC00 (0, XBUF, IC, BX, BY, %VAL(BUFFER)) RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Write out the bitmap. CALL GRCC01 (LUN, BX, BY, %VAL (BUFFER), MAXCOL, HIRES, CTAB) C Deallocate the plot buffer. IER = GRFMEM (BX * BY, BUFFER) C Check for an error. IF (IER .NE. 1) THEN CALL GRGMSG (IER) CALL GRWARN ('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) MAXCOL = MAX (IC, MAXCOL) RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C (Not implemented: should not be called.) C 190 CONTINUE GOTO 900 C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C (Not implemented: should not be called.) C 200 CONTINUE GOTO 900 C C--- IFUNC = 21, Set color representation. ----------------------------- C 210 CONTINUE I = INT (RBUF(1) + 1.5) CTAB(1, I) = INT (RBUF(2) * 100.0 + 0.5) CTAB(2, I) = INT (RBUF(3) * 100.0 + 0.5) CTAB(3, I) = INT (RBUF(4) * 100.0 + 0.5) RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C (Not implemented: should not be called.) C 220 CONTINUE GOTO 900 C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C (Not implemented: should not be called.) C 240 CONTINUE GOTO 900 C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C*GRCC00 -- PGPLOT LJ250 driver, draw a colored line C+ SUBROUTINE GRCC00 (LINE, RBUF, ICOL, BX, BY, BITMAP) IMPLICIT NONE INTEGER*4 BX, BY, ICOL, LINE BYTE BITMAP(BX, BY) REAL*4 RBUF(4) C C Draw a straight line segment from absolute pixel coordinates (RBUF(1), C RBUF(2)) to (RBUF(3), RBUF(4)). The line overwrites the previous C contents of the bitmap with the current color index. The line is C generated with a Simple Digital Differential Analyser (ref: Newman & C Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R Ending point of line. C ICOL I I Color index C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- INTEGER*4 K, KX, KY, LENGTH REAL*4 D, XINC, XP, YINC, YP C----------------------------------------------------------------------- IF (LINE .GT. 0) THEN D = MAX (ABS (RBUF(3) - RBUF(1)), ABS (RBUF(4) - RBUF(2))) LENGTH = D IF (LENGTH .EQ. 0) THEN XINC = 0.0 YINC = 0.0 ELSE XINC = (RBUF(3) - RBUF(1)) / D YINC = (RBUF(4) - RBUF(2)) / D END IF ELSE LENGTH = 0 XINC = 0.0 YINC = 0.0 END IF XP = RBUF(1) + 0.5 YP = RBUF(2) + 0.5 DO K = 0, LENGTH KX = XP KY = (BY - 1) - INT (YP) BITMAP(KX + 1, KY + 1) = ICOL XP = XP + XINC YP = YP + YINC END DO C----------------------------------------------------------------------- RETURN END C*GRCC01 -- PGPLOT LJ250 driver, copy bitmap to Sixel output file C+ SUBROUTINE GRCC01 (LUN, BX, BY, BITMAP, NC, HIRES, CTAB) IMPLICIT NONE LOGICAL HIRES INTEGER BX, BY, LUN, NC BYTE BITMAP(BX, BY), CTAB(3, 256) C C Arguments: C C LUN (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP (BY MUST be a multiple of 6) C BITMAP (input) the bitmap array C NC (input) the maximum color index used in the bitmap C CTAB (input) the color table C----------------------------------------------------------------------- BYTE ESC INTEGER*4 BUFF, GRCC03, I, IER, J, K, L, GRGMEM, M CHARACTER BLUE*3, COL*3, GREEN*3, RED*3 PARAMETER (ESC = 27) C----------------------------------------------------------------------- C Start Sixel graphics mode. IF (HIRES) THEN WRITE (LUN) ESC, 'P;1;;q"1;1;;-------' ELSE WRITE (LUN) ESC, 'P;1;8;q"1;1;;---' END IF C Write out the color table. DO I = 1, NC + 1 J = GRCC03 (I - 1) K = CTAB(1, I) K = GRCC03 (K) L = CTAB(2, I) L = GRCC03 (L) M = CTAB(3, I) M = GRCC03 (M) WRITE (COL, '(I3)') I - 1 WRITE (RED, '(I3)') CTAB(1, I) WRITE (GREEN, '(I3)') CTAB(2, I) WRITE (BLUE, '(I3)') CTAB(3, I) WRITE (LUN) '#', COL(4 - J : 3), ';2;', RED(4 - K : 3), ';', 1 GREEN(4 - L : 3), ';', BLUE(4 - M : 3) END DO C Allocate a work array. IER = GRGMEM (BX * (NC + 1), BUFF) C Check for an error. IF (IER .NE. 1) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate temporary buffer.') END IF C Output the Sixel data. CALL GRCC02 (LUN, BX, BY, BITMAP, NC + 1, %VAL (BUFF)) C Turn off Sixel graphics mode. WRITE (LUN) ESC, CHAR(92) C----------------------------------------------------------------------- RETURN END C*GRCC02 -- PGPLOT LJ250 driver, output the bitmap C+ SUBROUTINE GRCC02 (LUN, BX, BY, BITMAP, NC, SIXEL) IMPLICIT NONE INTEGER BX, BY, LUN, NC BYTE BITMAP(BX, BY), SIXEL(BX, NC) C C Version 1.0 18-Jun-1989 S. C. Allendorf C----------------------------------------------------------------------- BYTE CH, QMASK(6) LOGICAL OUTPUT INTEGER*4 GRCC03, I, J, K, L, M, N, REPCNT CHARACTER COL*3, OUTLINE*1445, REP*4 DATA QMASK /'01'X, '02'X, '04'X, '08'X, '10'X, '20'X/ C----------------------------------------------------------------------- C Output the Sixel data. DO I = 1, BY / 6 C Zero out the work array. CALL GRCC04 (BX * NC, SIXEL) C Create a Sixel line. DO J = 1, 6 DO K = 1, BX L = BITMAP(K, (I - 1) * 6 + J) + 1 SIXEL(K, L) = SIXEL(K, L) .OR. QMASK(J) END DO END DO C Loop through each color plane. DO J = 1, NC C Add the Sixel offset. DO K = 1, BX SIXEL(K, J) = SIXEL(K, J) + 63 END DO C Initialize some variables for C run-length encoding. K = 1 L = 1 M = 1 OUTPUT = .FALSE. C Stop if we are at the end of the C line. 10 IF (K .LE. BX) THEN C Find the next character. CH = SIXEL(K, J) C Count the repeats. 20 IF (M .LE. BX .AND. CH .EQ. SIXEL(M, J)) THEN M = M + 1 GOTO 20 END IF C Determine the length. REPCNT = M - K C See if there is any printable C data in this buffer. IF (REPCNT .NE. BX .OR. SIXEL(M - 1, J) .NE. 63) THEN C Mark the buffer as containing C printable data. OUTPUT = .TRUE. C Fill the output buffer. IF (REPCNT .GE. 3) THEN WRITE (REP, '(I4)') REPCNT N = GRCC03 (REPCNT) OUTLINE(L : L) = '!' OUTLINE(L + 1 : L + N) = REP (5 - N : 4) OUTLINE(L + N + 1 : L + N + 1) = 1 CHAR (SIXEL(M - 1, J)) L = L + N + 2 ELSE DO N = 0, REPCNT - 1 OUTLINE(L + N : L + N) = CHAR (SIXEL(M - 1, J)) END DO L = L + REPCNT END IF END IF C Reinitialize the starting point C for the next string and jump to C start of run length encoding. K = M GOTO 10 END IF C Write out the buffer if there is C any data in it. IF (OUTPUT) THEN WRITE (COL, '(I3)') J - 1 N = GRCC03 (J - 1) WRITE (LUN) '#', COL(4 - N : 3), OUTLINE(1 : L - 1), '$' END IF END DO C Output a graphics linefeed. WRITE (LUN) '-' END DO C------------------------------------------------------------------------ RETURN END C*GRCC03 -- PGPLOT LJ250 driver, calculate length of an integer C+ INTEGER FUNCTION GRCC03 (I) INTEGER I C C This function calculates the number of digits in a supplied integer. C C Arguments: C C I I I Integer value of number C GRCC03 O I Length of printed representation of I C C Version 1.0 10-Feb-1988 S. C. Allendorf C----------------------------------------------------------------------- IF (I .GE. 10) THEN IF (I .GE. 100) THEN IF (I .GE. 1000) THEN GRCC03 = 4 ELSE GRCC03 = 3 END IF ELSE GRCC03 = 2 END IF ELSE GRCC03 = 1 END IF C----------------------------------------------------------------------- RETURN END C*GRCC04 -- zero fill buffer C+ SUBROUTINE GRCC04 (BUFSIZ,BUFFER) C C GRPCKG (internal routine): fill a buffer with a given character. C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL /0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END C 210 CONTINUE I = INT (RBUF(1) + 1.5) CTAB(1, I) = INT (RBUF(2) * 100.0 + 0.5) CTAB(2, I) = INT (RBUF(3) * 100.0 + 0.5) CTAB(3, I) = INT (RBUF(4) * 100.0 + 0.5) pgplot/drivers/cwdriv.f010064400040640000322000000144260566742214300156750ustar00tjpcitmbr00000400000017C*CWDRIV -- PGPLOT driver for Colorwriter 6320 plotter C+ SUBROUTINE CWDRIV (OPCODE, RBUF, NBUF, CHR, LCHR) INTEGER OPCODE,NBUF,LCHR REAL RBUF(*) CHARACTER*(*) CHR C C Supported device: Gould (now Bryans) Colourwriter 6320 or any C device obeying Gould Plotter Language. [This appears to be very C similar to HP-GL, Hewlett-Packard Graphics Language.] C C Device type code: /CW6320 C C Default file name: pgplot.cwpl C C Default view surface dimensions: 280mm by 360mm (A3) C C Resolution: 0.025mm C C Colour Capability: Up to 10 pens. Default is pen 1 which is picked up C on initialization without a call to PGSCI. Calls to PGSCI are C interpreted as the pen number and colours therefore depend on how the C pens have been loaded into the stalls. If a call is made for a pen C higher than 10 the selected pen defaults to 1. C C Input Capability: Possible but not supported. C C File format: Ascii character strings.It is possible to send the C data to a file which can then be copied to the plotter or C on a terminal. C-- C Version dated 880314. Written by Len Pointon (Jodrell Bank). C Revised 941201 by T. Pearson (standard Fortran-77). C----------------------------------------------------------------------- INTEGER LUN, IER, IC INTEGER X1,Y1,X2,Y2,XOLD,YOLD INTEGER GROPTX CHARACTER*10 MSG CHARACTER*(*) DEVTYP,DEFNAM PARAMETER (DEVTYP = 'CW6320 (Colorwriter 6320 plotter)') PARAMETER (DEFNAM = 'pgplot.cwpl') * Go to the function specified by OPCODE GOTO (10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), OPCODE * Error return ,unrecognised value for OPCODE WRITE (MSG,'(I10)') OPCODE CALL GRWARN('Unknown opcode in '//DEVTYP//' device driver:'//MSG) NBUF = -1 RETURN * OPCODE = 1, Return device name 10 CHR = DEVTYP LCHR = LEN(DEVTYP) RETURN * OPCODE = 2, Return physical max & min for plot device and * range of colour indices. 20 RBUF(1) = 0.0 RBUF(2) = 14400.0 RBUF(3) = 0.0 RBUF(4) = 11200.0 RBUF(5) = 0.0 RBUF(6) = 10.0 NBUF = 6 RETURN * OPCODE = 3, Return device resolution 30 RBUF(1) = 1016.0 RBUF(2) = 1016.0 RBUF(3) = 12.0 NBUF = 3 RETURN * OPCODE = 4, Return misc. device information * (hardcopy,No cursor,No dashed lines,No area fill, * No thick lines) 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN * OPCODE = 5, Return default file name 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN * OPCODE = 6, Return default physical size of plot 60 RBUF(1) = 0.0 RBUF(2) = 14400.0 RBUF(3) = 0.0 RBUF(4) = 11200.0 NBUF = 4 RETURN * OPCODE = 7, Return misc. defaults * (Character scale factor,not sure what to put here so * try value pinched from QMDRIVER) 70 RBUF(1) = 8.0 NBUF = 1 RETURN * OPCODE = 8, Select plot * (Code set aside for future option,ignore it now) 80 CONTINUE RETURN * OPCODE = 9, Open workstation * Get a logical unit number 90 CALL GRGLUN(LUN) IF (LUN.EQ.-1) THEN CALL GRWARN('Failed to allocate I/O unit') RBUF(2) = 0.0 NBUF = 2 RETURN END IF * Open the file NBUF = 2 RBUF(1) = LUN IER = GROPTX(LUN, CHR(1:LCHR), DEFNAM, 1) IF (IER .NE. 0) THEN CALL GRWARN('Cannot open graphics device '//DEVTYP) RBUF(2) = 0.0 CALL GRFLUN(LUN) RETURN ELSE * -- Initialize and select pen 1 WRITE (LUN,*) 'IN;SP1;' RBUF(2) = 1.0 END IF RETURN * OPCODE = 10, Close workstation 100 CLOSE (LUN) CALL GRFLUN (LUN) RETURN * OPCODE = 11, Begin picture * (make sure pen is up and we are at the origin) 110 WRITE (LUN,*) 'PU;PA0,0' RETURN * OPCODE = 12, Draw line 120 X1 = NINT(RBUF(1)) Y1 = NINT(RBUF(2)) X2 = NINT(RBUF(3)) Y2 = NINT(RBUF(4)) * Decide if move is to be with pen up or down. * If first new x,y is same as old x,y move with pen down. * If not, move to first x,y with pen up then to second * x,y with pen down. IF (X1 .EQ. XOLD .AND. Y1 .EQ. YOLD) THEN WRITE (LUN,'(A,I5,A,I5,A)') 'PD;PA',X2,',',Y2,';' ELSE WRITE (LUN,'(A,I5,A,I5,A)') 'PU;PA',X1,',',Y1,';' WRITE (LUN,'(A,I5,A,I5,A)') 'PD;PA',X2,',',Y2,';' END IF * Save last position XOLD=X2 YOLD=Y2 RETURN * OPCODE = 13, Draw dot 130 X1 = NINT(RBUF(1)) Y1 = NINT(RBUF(2)) WRITE (LUN,'(A,I5,A,I5,A)') 'PU;PA',X1,',',Y1,';PD;PU;' RETURN * OPCODE = 14, End picture * (Advances the page one complete page) 140 WRITE (LUN,*) 'AF;' RETURN * OPCODE = 15, Select colour index 150 IC = NINT(RBUF(1)) IF (IC .LT. 1) IC = 1 IF (IC .GT. 10) IC = 1 WRITE (LUN,'(A,I5,A)') 'SP',IC,';' RETURN * OPCODE = 16, Flush buffer * (Not applicable to hard copy device) 160 CONTINUE RETURN * OPCODE = 17, Read cursor * (If we get here it must be an error) 170 NBUF = -1 LCHR = 0 RETURN * OPCODE = 18, Erase alpha screen * (Not applicable) 180 CONTINUE RETURN * OPCODE = 19, Set line style * (Ignore this) 190 CONTINUE RETURN * OPCODE = 20, Polygon fill * (Ignore this) 200 CONTINUE RETURN * OPCODE = 21, Set colour representation * (Ignore this) 210 CONTINUE RETURN * OPCODE = 22, Set line width * (Ignore this) 220 CONTINUE RETURN * OPCODE =23, Escape * (Ignore this) 230 CONTINUE RETURN END pgplot/drivers/epdriv.f010064400040640000322000000140030575372533300156620ustar00tjpcitmbr00000400000017 SUBROUTINE EPDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) C GRPCKG driver for EPSON FX100 dot matrix printer. C C Apr-1987 - Floating-point input version Apr 1987 [PSB]. C 16-Jan-1988 - Compile with /WARN=(DECLARE) switch [AFT]. C--- CHARACTER ESC, DUAL PARAMETER (ESC=CHAR(27)) PARAMETER (DUAL=CHAR(1)) REAL PL, PL1 PARAMETER (PL=765,PL1=PL-1) REAL RBUF(6) INTEGER IFUNC, NBUF, LCHR CHARACTER CHR*(*) C INTEGER GRGMEM, GRFMEM, GRTRIM INTEGER XYMAP, LENOLD, IST, IXDIM, IYDIM, LENBUF INTEGER I, J, N, ICOL, LUN INTEGER*2 BUF(0:1632) CHARACTER NN*2 SAVE LUN,XYMAP,ICOL,IXDIM,IYDIM,LENOLD,LENBUF DATA LENOLD/0/ C--- GOTO (100,200,300,400,500,600,700,800,900,1000, : 1100,1200,1300,1400,1500) IFUNC GOTO 999 C C 1: Return device name: 100 CHR = 'EPSON (Epson dot matrix printer)' LCHR = GRTRIM(CHR) RETURN C C 2: Return physical min & max for device: 200 RBUF(1) = 0 RBUF(2) = 1631 C ! dual-density 120/" RBUF(3) = 0 RBUF(4) = -1 C ! as long as a box of paper... RBUF(5) = 0 C ! min colour RBUF(6) = 1 C ! max colour NBUF = 6 RETURN C C 3: Return device resolution: 300 RBUF(1) = 120.0 C ! horiz dots per inch RBUF(2) = 72.0 C ! veric dots per inch RBUF(3) = 1.0 C ! thick lines RETURN C C 4: Return misc info: C H= Hardcopy device C N= No cursor C N= No hard dash C N= No area fill C N= No hard thick lines 400 CHR(1:10) = 'HNNNNNNNNN' RETURN C C 5: Return default file name: 500 CHR = 'PGPLOT.EPS' LCHR = LEN(CHR) RETURN C C 6: Return default size of plot: 600 RBUF(1) = 0 RBUF(2) = 1631 RBUF(3) = 0 RBUF(4) = PL1 C ! 72 ./" -> 11" PAGE. RETURN C C 7: Return misc defaults: 700 RBUF(1) = 1. ICOL = 1 RETURN C C 8: Select Plot: 800 RETURN C C 9: Open device: 900 CALL GRGLUN(LUN) OPEN(LUN,FILE=CHR(:LCHR),STATUS='NEW', 1 RECORDTYPE='VARIABLE',RECL=4000) RBUF(1) = LUN RBUF(2) = 1 RETURN C C 10: Close device: 1000 CLOSE(UNIT=LUN) CALL GRFLUN(LUN) IF(LENOLD.GT.0) THEN IST = GRFMEM(LENOLD,XYMAP) IF(IST.NE.1) STOP 'error freeing memory in EPDRIV' LENOLD=0 ENDIF RETURN C C 11: Initialise plot: 1100 IXDIM = RBUF(1) + 1 IYDIM = RBUF(2)/9 + 1 LENBUF = IXDIM*IYDIM*2 C ! length of buffer in bytes IF(LENBUF.NE.LENOLD) THEN IF(LENOLD.GT.0) THEN IST = GRFMEM(LENOLD,XYMAP) IF(IST.NE.1) STOP 'error freeing memory in EPDRIV' LENOLD=0 ENDIF IST = GRGMEM(LENBUF,XYMAP) IF(IST.NE.1) STOP 'error allocating memory in EPDRIV' LENOLD = LENBUF ENDIF CALL GREP03(LENBUF,%VAL(XYMAP)) RETURN C C 12: Draw a line: 1200 CALL GREP01(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP)) RETURN C C 13: Draw a dot: 1300 CALL GREP02(RBUF,ICOL,IXDIM-1,IYDIM-1,%VAL(XYMAP)) RETURN C C 14: Close plot: 1400 CONTINUE C C Initialise printer: WRITE(LUN,1411) ESC,'A',CHAR(9) C ! 9 dots per line; 1411 FORMAT(1X,3A1) DO 1460 J=0,IYDIM-1 CALL GREP04(%VAL(XYMAP+IXDIM*J*2),IXDIM,BUF) C C Find last non-zero dot position: DO 1430 I=IXDIM-1,0,-1 N = I + 1 IF(BUF(I).NE.0) GOTO 1440 1430 CONTINUE 1440 CONTINUE NN(1:1) = CHAR(N.AND.255) NN(2:2) = CHAR(N/256) BUF(N) = '0A0D'X C ! CR LF WRITE(LUN,1441) ESC,';',DUAL,NN,(BUF(I),I=0,N) 1441 FORMAT(1X,3A1,A2,1632A2) 1460 CONTINUE C C Reset printer to normal: WRITE(LUN,1461)ESC,'2',CHAR(13) C ! 1/6 line spacing 1461 FORMAT(1X,3A1) RETURN C C 15: Set colour: 1500 ICOL = MAX(MIN(NINT(RBUF(1)),1),0) C ! only black or white. RBUF(1) = ICOL RETURN C--- C--- Flag function not implemented. 999 NBUF=-1 RETURN END SUBROUTINE GREP01(RBUF,ICOL,IXDIM,IYDIM,XYMAP) C- Draw a line on Epson: REAL RBUF(6) INTEGER ICOL, IXDIM, IYDIM INTEGER*2 XYMAP(0:IXDIM,0:IYDIM) C REAL XL, YL, D, XP, YP, XINC, YINC INTEGER L, LENGTH, IX, IY, IYBIT INTEGER*2 BITS(0:8) DATA BITS/128,64,32,16,8,4,2,1,-32768/ C--- XL = RBUF(3) - RBUF(1) YL = RBUF(4) - RBUF(2) D = MAX(ABS(XL),ABS(YL),1.0) LENGTH = NINT(D) XP = RBUF(1) YP = RBUF(2) XINC = XL/D YINC = YL/D DO 180 L = 0,LENGTH IX = NINT(XP) IY = IYDIM*9 - NINT(YP) IYBIT = MOD(IY,9) IF(ICOL.GT.0) THEN XYMAP(IX,IY/9) = : XYMAP(IX,IY/9).OR.BITS(IYBIT) ELSE XYMAP(IX,IY/9) = : XYMAP(IX,IY/9).AND.(.NOT.BITS(IYBIT)) ENDIF XP = XP + XINC YP = YP + YINC 180 CONTINUE RETURN END SUBROUTINE GREP02(RBUF,ICOL,IXDIM,IYDIM,XYMAP) C C- Draw a dot: REAL RBUF(6) INTEGER ICOL, IXDIM, IYDIM INTEGER*2 XYMAP(0:IXDIM,0:IYDIM) C INTEGER IY, IYBIT INTEGER*2 BITS(0:8) DATA BITS/128,64,32,16,8,4,2,1,-32768/ C--- IY = IYDIM*9 - NINT(RBUF(2)) IYBIT = MOD(IY,9) XYMAP(NINT(RBUF(1)),IY/9) = :XYMAP(NINT(RBUF(1)),IY/9).OR.BITS(IYBIT) RETURN END SUBROUTINE GREP03(LENBUF,XYMAP) C- Erase bitmap INTEGER LENBUF, XYMAP(*) INTEGER I C--- DO 180 I=1,LENBUF/4 XYMAP(I) = 0 180 CONTINUE RETURN END SUBROUTINE GREP04(XYMAP,IXDIM,BUF) C- Copy a line of output to buf INTEGER IXDIM INTEGER*2 XYMAP(IXDIM), BUF(IXDIM) INTEGER I C--- DO 180 I=1,IXDIM BUF(I) = XYMAP(I) 180 CONTINUE RETURN END pgplot/drivers/exdriv.f010064400040640000322000000337120566021423300156670ustar00tjpcitmbr00000400000017C*EXDRIV -- PGPLOT Talaris/EXCL driver (landscape mode) C+ SUBROUTINE EXDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for EXCL devices (Talaris) C----------------------------------------------------------------------- C Version 1.0 - 1989 Nov 10 - A. L. Fey. C 2.0 - 1994 Nov 08 C----------------------------------------------------------------------- C C Supported device: Any Talaris printer that accepts the EXCL C page description language. 7-bit mode is used. C C Device type code: /EXCL (landscape) C /VEXCL (portrait) C C Default file name: pgplot.explot. C C Default view surface dimensions: 10.25 inches horizontal x 7.75 inches C vertical (landscape mode). C Default view surface dimensions: 7.75 inches horizontal x 10.25 inches C vertical (portrait mode). C C Resolution: The driver uses coordinate increments of 1/1000 inch. C The true resolution is device-dependent; at time of C writing, it is typically 300 dots per inch. C C Color capability: Color indices 0 (erase), and 1 (black) are C supported. Requests for other color indices are C converted to 1. It is not possible to change color C representation. C C Input capability: None. C C File format: Ascii, variable length records (max 80 bytes). C----------------------------------------------------------------------- C CHARACTER*(*) DEFNAM REAL WIDTH, HEIGHT, MARGIN C-- PARAMETER (DEFNAM = 'pgplot.explot') PARAMETER (WIDTH = 11000.0) PARAMETER (HEIGHT = 8500.0) PARAMETER (MARGIN = 375) C-- CHARACTER*(*) ESC, SP, ESCP, ESCLB, ESCBS PARAMETER (ESC = CHAR (27)) PARAMETER (SP = CHAR (32)) PARAMETER (ESCP = CHAR (27)//CHAR (80)) PARAMETER (ESCLB = CHAR (27)//CHAR (91)) PARAMETER (ESCBS = CHAR (27)//CHAR (92)) C CHARACTER*80 BUFFER CHARACTER*80 INSTR CHARACTER*10 MSG INTEGER UNIT, I0, J0, I1, J1, IC INTEGER L, NPAGE, NPTS, PENWID REAL EXSCAL, EYSCAL REAL EXSIZE, EYSIZE REAL XRESOL, YRESOL LOGICAL NOTHIN INTEGER GRTRIM, GROPTX C C ---- BUFFER should not exceed 80 - this makes well formed EXCL files. C ---- The E*SIZE parameters are the physical size of the plot (used C ---- more than once here) in resolution units (1/1000 inch). The C ---- *OFF parameters are offsets from the physical origin of the C ---- page assuming a page size of 8.5 x 11 inches. The E*SCAL C ---- parameters are PGPLOT-modifiable scale factors. C PARAMETER (XRESOL = 1000.00, : YRESOL = 1000.00, : PENWID = 5) SAVE EXSIZE, EYSIZE C C======================================================================= C C ---- Do the best one can in F77 for a "case" statement. -------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC C C ---- Unknown opcode/function; most likely a logic error somewhere ---- C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in EXCL device driver:'//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF(MODE .EQ. 1) THEN CHR = 'EXCL (Talaris/EXCL printers, landscape)' ELSE CHR = 'VEXCL (Talaris/EXCL printers, portrait)' END IF LCHR = GRTRIM(CHR) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C Units are in device co-ordinates (1/1000 inches) C 20 RBUF(1) = 0.0 RBUF(3) = 0.0 RBUF(5) = 0.0 RBUF(6) = 1.0 IF(MODE .EQ. 1) THEN RBUF(2) = WIDTH - 2*MARGIN RBUF(4) = HEIGHT - 2*MARGIN ELSE RBUF(2) = HEIGHT - 2*MARGIN RBUF(4) = WIDTH - 2*MARGIN END IF NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = XRESOL RBUF(2) = YRESOL C C (multiple strokes are spaced by PENWID/*RESOL inches) C RBUF(3) = PENWID NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Hardcopy, No cursor, No Dashed lines, Area fill, No Thick lines) C 40 CHR = 'HNNANNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C (in device coordinates). C 60 RBUF(1) = 0.0 RBUF(3) = 0.0 IF(MODE .EQ. 1) THEN RBUF(2) = WIDTH - 2*MARGIN RBUF(4) = HEIGHT - 2*MARGIN ELSE RBUF(2) = HEIGHT - 2*MARGIN RBUF(4) = WIDTH - 2*MARGIN END IF NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1.0 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C Future option, nothing done yet. (Multiple devices open at one C time will be allowed later; this opcode will select active device). C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C C -- Get a Unit number. C CALL GRGLUN(UNIT) C C -- Open the file. C NBUF = 2 RBUF(1) = UNIT IF(GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) .NE. 0) THEN CALL GRWARN('Cannot open output file for EXCL plot') RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = GRTRIM(CHR) RBUF(2) = 1 END IF C C -- initialization C EXSCAL = 1.0 EYSCAL = 1.0 IF(MODE .EQ. 1) THEN EXSIZE = WIDTH - 2 * MARGIN EYSIZE = HEIGHT - 2 * MARGIN ELSE EXSIZE = HEIGHT - 2 * MARGIN EYSIZE = WIDTH - 2 * MARGIN END IF NOTHIN = .TRUE. NPAGE = 0 NPTS = 0 C C -- Start vector graphics mode. C Initialize EXCL, set ANSI mode to EXCL (TALAMS), reset the C printstation to power-up state (TALMOD), set copy count C to one (TALCCNT), set paper size to letter (TALFCTL), C turn on Absorb Forms Control (TALASF). C BUFFER = ESCLB//'0*s' : //ESCLB//'1;0r' : //ESCLB//'1;0u' : //ESCLB//';3x' : //ESCLB//'1'//SP//'z' CALL GREX00 (UNIT, BUFFER, 27) C C -- Comments; write user and date created to file. C CALL GREX00 (UNIT, : ESC//'Q ------------------------------ '//ESC//'R', 36) CALL GRUSER (INSTR, L) BUFFER = : ESC//'Q -- EXCL plot created by '//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 33+L) CALL GRDATE (INSTR, L) BUFFER = : ESC//'Q -- EXCL plot created on '//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 33+L) CALL GREX00 (UNIT, : ESC//'Q ------------------------------ '//ESC//'R', 36) RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE C IF (NOTHIN) THEN C C -- Nothing was plotted so no need to keep the file around. C CLOSE (UNIT) C ELSE C C -- Don't need to formfeed; end picture will do that. C Reset printstation to its power-up state. C BUFFER = ESC//'Q -- End of File -- '//ESC//'R'//ESC//'c' CALL GREX00 (UNIT, BUFFER, 25) CLOSE (UNIT) ENDIF C C -- Return UNIT to free pool. C CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture and possibly rescale ----------------------- C 110 CONTINUE NPAGE = NPAGE + 1 C C -- Define the unit of measure to be mils (TALPRM), define the page C orientation to be landscape or portrait (TALPGO), set page C clipping window to default page size (TALPCW), and set the C origin to the top left of the physical page at MARGIN,MARGIN C (TALORG). C BUFFER = ESCLB//'3y' : //ESCLB//'0p' : //ESCLB//'0;;;0*c' IF(MODE .EQ. 1) THEN BUFFER(7:7)='1' ELSE BUFFER(7:7)='0' END IF WRITE (BUFFER (18:31), 1000) ESCLB, MARGIN, MARGIN 1000 FORMAT (A2, I5.5, ';', I5.5, 'o') CALL GREX00 (UNIT, BUFFER, 31) C C -- Set the line defaults (TALGLP, TALGLT) and set fill C pattern (TALGRP). C BUFFER = ESCLB//' ; ;8;1;112;5279;1*w' : //ESCLB//'112;5279;0*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 42) C C -- Rescale if needed. C EXSCAL = MIN (1.0, RBUF(1) / EXSIZE) EYSCAL = MIN (1.0, RBUF(2) / EYSIZE) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C C -- Move with TALGMV, draw with TALGDW. C 120 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) I1 = NINT(RBUF(3) * EXSCAL) J1 = NINT((EYSIZE - RBUF(4)) * EYSCAL) 125 CONTINUE IF(MODE.EQ.1) THEN WRITE (BUFFER( 1:15), 2000) ESCLB, I0, J0, '*m' WRITE (BUFFER(16:30), 2000) ESCLB, I1, J1, '*d' ELSE WRITE (BUFFER( 1:15), 2001) ESCLB, I0, J0, '*m' WRITE (BUFFER(16:30), 2001) ESCLB, I1, J1, '*d' ENDIF 2000 FORMAT (A2, ';', I5.5, ';', I4.4, A2) 2001 FORMAT (A2, ';', I4.4, ';', I5.5, A2) CALL GREX00 (UNIT, BUFFER, 30) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C EXCL takes care of dot size by the pen width command so we C don't have to worry about it here. Just draw to same point and C let the "draw line" code handle it. C 130 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) I1 = I0 J1 = J0 GOTO 125 C C--- IFUNC=14, End picture --------------------------------------------- C C -- Eject page and clear bitmap (TALFPO). C 140 CONTINUE C IF (.NOT. NOTHIN) THEN CALL GRFAO ('Q -- End Page: # ', L, INSTR, NPAGE, 0, 0, 0) BUFFER = ESCLB//'0*F'//ESC//INSTR(1:L)//' -- '//ESC//'R' CALL GREX00 (UNIT, BUFFER, 12+L) ENDIF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C C Use TALGLP. C 150 CONTINUE IC = RBUF(1) C IF (IC .EQ. 0) THEN C C -- Color index 0 is erase. C BUFFER = ESCLB//' ; ;11;1;112;5279;1*w' : //ESCLB//'112;5279;11*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 44) ELSE IF (IC .EQ. 1) THEN C C -- Color index 1 is black. C BUFFER = ESCLB//' ; ;8;1;112;5279;1*w' : //ESCLB//'112;5279;0*r' : //ESCLB//'*t' WRITE (BUFFER (3:4), '(I2.2)') PENWID WRITE (BUFFER (6:7), '(I2.2)') PENWID CALL GREX00 (UNIT, BUFFER, 42) ELSE IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C Hardcopy so ignore it C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented, hardcopy device. Return error code. C 170 CONTINUE NBUF = -1 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen so ignore it). C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C C -- Use TALPFL to fill polygon. C 200 CONTINUE C C -- Use NPTS as our indicator of whether this is first time or not. C IF (NPTS .EQ. 0) THEN C C -- First time so set number of points in polygon and start polygon C command. C NPTS = RBUF (1) BUFFER = ESCP//'4;1;0;1}' CALL GREX00 (UNIT, BUFFER, 10) ELSE C C -- Second or other time so decrement NPTS and draw to next vertex. C IF (NOTHIN) NOTHIN = .FALSE. NPTS = NPTS - 1 I0 = NINT(RBUF(1) * EXSCAL) J0 = NINT((EYSIZE - RBUF(2)) * EYSCAL) IF(MODE .EQ. 1) THEN WRITE (BUFFER, 3000) I0, J0 ELSE WRITE (BUFFER, 3001) I0, J0 END IF 3000 FORMAT (I5.5, ':', I4.4, ';') 3001 FORMAT (I4.4, ':', I5.5, ';') CALL GREX00 (UNIT, BUFFER, 11) C C -- Give the polygon fill command on last call. C IF (NPTS .EQ. 0) THEN BUFFER = ESCBS CALL GREX00 (UNIT, BUFFER, 2) END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored. Will we ever get color laser printers?) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape -------------------------------------------------- C Note that the NOTHIN flag which indicates if there is anything C written on the paper is set here regardless of the content of C the escape characters. C 230 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. RETURN C----------------------------------------------------------------------- END C*GREX00 -- PGPLOT Talaris/EXCL driver, flush buffer C+ SUBROUTINE GREX00 (LUN, BUF, SIZ) CHARACTER*(*) BUF INTEGER LUN, SIZ C-- WRITE (LUN, '(A)') BUF(1:SIZ) END 0.0 RBUF(3) = 0.0 RBUF(5) = 0.0 RBUFpgplot/drivers/gcdriv.f010064400040640000322000000247650641627145700156670ustar00tjpcitmbr00000400000017C*GCDRIV -- PGPLOT Genicom printer driver C+ SUBROUTINE GCDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Genicom printer device. C C This driver is a copy of pxdriver.for with minor changes to put C the genicom printer in the proper mode and scale correctly. C Version 1.0 - 1990 Feb 12 - J. H. Trice. C======================================================================= C C Supported device: Genicom 4410 dot-matrix printer. C C Device type code: /GENICOM. C C Default device name: PGPLOT.PRPLOT. C C Default view surface dimensions: 10.25in (horizontal) by 7.8in C (vertical). C C Resolution: 144 (x) x 140 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 197 bytes, with C embedded carriage-control characters. A full-page plot occupies C 600 512-byte blocks. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE= : 'GENICOM (Genicom 4410 dot-matrix printer, landscape)') PARAMETER (DEFNAM='PGPLOT.PRPLOT') BYTE FF PARAMETER (FF=12) C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER BITMAP C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 1510 RBUF(3) = 0 RBUF(4) = 1154 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 144.0 RBUF(2) = 140.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 1510 RBUF(3) = 0 RBUF(4) = 1154 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- dimensions of plot buffer BY = 194 ! 1164/6 BX = 1520 CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 RECL=197, 3 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER CLOSE (UNIT=UNIT, DISPOSE='DELETE') CALL GRFLUN(UNIT) END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE NPICT = NPICT+1 C% type *,'Begin picture',NPICT IF (NPICT.GT.1) WRITE (UNIT=UNIT) FF CALL GRGC03(BX*BY, %val(BITMAP), 'C0'X) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE CALL GRGC01(1, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE CALL GRGC01(0, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT CALL GRGC02(UNIT, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRGC01 -- PGPLOT Genicom printer driver, draw line C+ SUBROUTINE GRGC01 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BY,BX) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:5) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'01'x,'02'x,'04'x,'08'x,'10'x,'20'x/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = D IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO K=0,LENGTH KY = BX - XP -5 KX = (BY*6-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .OR. 1 QMASK(MOD(KX,6)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K=0,LENGTH KY = BX - XP -5 KX = (BY*6-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .AND. 1 (.NOT.QMASK(MOD(KX,6))) XP = XP + XINC YP = YP + YINC END DO END IF END C*GRGC02 -- PGPLOT Genicom driver, copy bitmap to output file C+ SUBROUTINE GRGC02 (UNIT, BX, BY, BITMAP) INTEGER UNIT, BX, BY BYTE BITMAP(BY,BX) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE SUFFIX(3),PREGEN(10),POSTGEN(2) DATA SUFFIX/ 5, 13, 10/ DATA PREGEN/27, 91,52,59,54,59,53,113,27,80/ DATA POSTGEN/27, 92/ INTEGER I, J, K C C WRITE PREFIX TO PUT IN HIGH DENSITY GRAPHICS MODE C WRITE(UNIT=UNIT) PREGEN C C Write bitmap. C DO J=1,BX DO K=BY,2,-1 IF (BITMAP(K,J).NE.'C0'X) GOTO 10 END DO 10 WRITE (UNIT=UNIT) (BITMAP(I,J),I=1,K),SUFFIX END DO WRITE(UNIT=UNIT) POSTGEN C C Write blank plot lines to fill up page C END C*GRGC03 -- fill buffer with a specified character C+ SUBROUTINE GRGC03 (BUFSIZ,BUFFER,FILL) C C GRPCKG (internal routine): fill a buffer with a given character. C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C FILL (integer, input): the fill character. BUFSIZ bytes starting at C address BUFFER are set to contents of FILL. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE FILL BYTE BUFFER(BUFSIZ) C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END device, andpgplot/drivers/godriv.f010064400040640000322000000227060563172156600156730ustar00tjpcitmbr00000400000017 SUBROUTINE GODRIV(IFUNC,RBUF,NBUF,CHR,LCHR) C- GRPCKG driver for GOC(Sigma) terminal. C--- C Supported device: Sigma, T5670 terminal. C C Device type code: /GOC C C Default file name: TT(logical name, usually equivalent to the C logged in terminal). C C Default view surface dimensions: 38 cm display. C C Resolution: The full view surface is 768 by 512 pixels. C C Color capability: Color indices 0 (erase) and 1 are supported. C C Input capability: Cursor is a cross-hair and can be moved using C the joystick or the cursor keys to the left of the keyboard. C Terminate cursor motion and send the cursor position to the C program by typing any printable character on the keyboard. C C File format: It is not possible to send GOC plots to a disk file. C C Obtaining hardcopy: A hardcopy of the plot may be obtained using C a Tekronix hardcopy unit attached to the terminal. C C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- CHARACTER GOCERA*(*) PARAMETER (GOCERA='BH'//CHAR(12)//'+-*/') INTEGER IFUNC,NBUF,LCHR,I0,J0,I1,J1 REAL RBUF(6) CHARACTER CHR*(*) INTEGER GRGE00 CHARACTER GOCSTR*2, GOCERG*2 DATA GOCERG/'DA'/ C INTEGER LUN,MXCNT,ICNT,IBADR,ICOL SAVE LUN,MXCNT,ICNT,IBADR,ICOL LOGICAL APPEND SAVE APPEND C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,170,180) IFUNC GOTO 999 C--- C- IFUNC= 1, Return device name. 10 CHR='GOC' LCHR=LEN(CHR) RETURN C--- C- IFUNC= 2, Return Physical min and max for plot device. 20 RBUF(1)=0 RBUF(2)=768 RBUF(3)=0 RBUF(4)=511 RBUF(5)=0 RBUF(6)=1 NBUF=6 RETURN C--- C- IFUNC= 3, Return device(X and Y) resolution in pixels per inch as C- formatted numbers in CHR. 30 RBUF(1)=76.8 RBUF(2)=76.8 RBUF(3)=1 NBUF=3 RETURN C--- C- IFUNC= 4, Return misc device info. 40 CHR='ICNNNNNNNN' LCHR=10 RETURN C--- C- IFUNC= 5, Return default file name. 50 CHR='TT' LCHR=LEN(CHR) NBUF=1 RETURN C--- C- IFUNC= 6, Return default physical size of plot. 60 RBUF(1)=0 RBUF(2)=768 RBUF(3)=0 RBUF(4)=511 RETURN C--- C- IFUNC= 7, Return misc defaults. 70 RBUF(1)=2 NBUF=1 RETURN C--- C- IFUNC= 8, Set active plot. 80 CALL INGO03(LUN) RETURN C--- C- IFUNC= 9, Open workstation. 90 APPEND=RBUF(3).NE.0.0 RBUF(2)=GRGE00('Q1 ',LUN,CHR,LCHR) RBUF(1)=LUN IF(RBUF(2).EQ.1) THEN CALL INGO03(LUN) MXCNT=130 CALL GRGMEM(MXCNT,IBADR) END IF RETURN C--- C- IFUNC=10, Close workstation. 100 CALL GRFMEM(MXCNT,IBADR) RETURN C--- C- IFUNC=11, Begin Picture. 110 CALL GRGO10 IF(.NOT.APPEND) THEN CALL GRGO02(%REF(GOCERG),LEN(GOCERG),%val(IBADR),ICNT,MXCNT) END IF APPEND=.FALSE. RETURN C--- C- IFUNC=12, Draw line. 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRGO01(I0,J0,I1,J1,%val(IBADR),ICNT,MXCNT) RETURN C--- C- IFUNC=13, Draw dot. 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRGO01(I0,J0,I0,J0,%val(IBADR),ICNT,MXCNT) RETURN C--- C- IFUNC=14, End Picture. 140 RETURN C--- C- IFUNC=15, Select pen. 150 RBUF(1) = MAX(0,MIN(NINT(RBUF(1)),1)) ICOL=RBUF(1) IF(ICOL.EQ.0) THEN GOCSTR='FB' ELSE GOCSTR='FA' END IF CALL GRGO02(%REF(GOCSTR),LEN(GOCSTR),%VAL(IBADR),ICNT,MXCNT) RETURN C--- C- IFUNC=16, Flush buffer. 160 CALL GRGO03(%val(IBADR),ICNT) RETURN C--- C- IFUNC=17, Make cursor visible and read position. 170 I0=RBUF(1) J0=RBUF(2) CALL GRGO11(LUN,I0,J0,CHR) RBUF(1)=I0 RBUF(2)=J0 NBUF=2 LCHR=1 RETURN C--- C- IFUNC=18, Erase alpha screen. 180 CALL GRGO03(%val(IBADR),ICNT) CALL GRGO02(%REF(GOCERA),LEN(GOCERA),%VAL(IBADR),ICNT,MXCNT) CALL GRGO03(%val(IBADR),ICNT) CALL INGO01 RETURN C--- C- Flag function not implemented. 999 NBUF=-1 RETURN C--- END SUBROUTINE GRGO01(X0,Y0,X1,Y1,IBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG(GOC) : draw a line from(X0,Y0) to(X1,Y1) C C( 4-Feb-1986 KS / AAO) C----------------------------------------------------------------------- INTEGER X0, Y0, X1, Y1, IBUF, ICNT, MXCNT INTEGER IGNORE, PTR CHARACTER STRING*22 INTEGER LSTI,LSTJ SAVE LSTI,LSTJ C--- IF(X0.NE.LSTI .OR. Y0.NE.LSTJ) THEN STRING(1:2) = 'GI' ! Pen up WRITE(STRING(3:8),'(2I3.3)',IOSTAT=IGNORE) X0+100,Y0+100 STRING(9:10) = 'GJ' ! Pen down PTR=11 ELSE PTR=1 END IF WRITE(STRING(PTR:PTR+5),'(2I3.3)',IOSTAT=IGNORE) 1 X1+100, Y1+100 CALL GRGO02(%REF(STRING),PTR+5,IBUF,ICNT,MXCNT) LSTI = X1 LSTJ = Y1 RETURN C--- ENTRY INGO01 LSTI=-1 LSTJ=-1 RETURN C--- END C********* SUBROUTINE GRGO02(INSTR,N,QBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG(GOC) : transfer N bytes to output QBUF C from INSTR(1...N). QBUF has to be passed since it is a C dynamic array. N should be less than 32, and the routine C always ensures that at least 32 bytes are left spare in the C buffer. C C( 4-Feb-1986 KS / AAO) C----------------------------------------------------------------------- C INTEGER N,ICNT,MXCNT BYTE INSTR(N) BYTE QBUF(*) C--- INTEGER I CHARACTER INIT*6 DATA INIT/'+-*/GJ'/ C IF(ICNT.EQ.0) THEN DO I=1,LEN(INIT) QBUF(I) = ICHAR(INIT(I:I)) END DO ICNT = LEN(INIT) END IF DO I=1,N ICNT = ICNT+1 QBUF(ICNT) = INSTR(I) END DO IF(ICNT+32 .GE. MXCNT) CALL GRGO03(QBUF,ICNT) RETURN END C********* SUBROUTINE GRGO03(QBUF,ICNT) C----------------------------------------------------------------------- C GRPCKG(GOC): flush buffer contents. QBUF is passed as C an argument because it is a dynamic array. C C( 4-Feb-1986 KS / AAO ) C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER SYS$QIOW C INTEGER ICNT,INLUN BYTE QBUF(*) C INTEGER WRITE PARAMETER(WRITE=IO$_WRITEVBLK+IO$M_NOFORMAT+IO$M_CANCTRLO) INTEGER RESULT, N INTEGER IOSB(2) INTEGER*2 STBC(2), STATUS, COUNT INTEGER LUN SAVE LUN C--- EQUIVALENCE(STBC, IOSB(1)),(STATUS, STBC(1)),(COUNT, STBC(2)) C C Insert 'return to alpha mode' code into end of buffer. C N = ICNT IF(N.LT.1) RETURN QBUF(N+1)=ICHAR('B') QBUF(N+2)=ICHAR('H') N=N+2 CALL INGO01 ICNT = 0 C C Now flush buffer C RESULT = SYS$QIOW(,%VAL(LUN),%VAL(WRITE),IOSB,, 1 ,QBUF,%VAL(N),,,,) IF(RESULT.NE.SS$_NORMAL) THEN CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW failure writing to GOC terminal') END IF IF((STATUS.NE.SS$_NORMAL) .AND. 1 (STATUS.NE.SS$_CONTROLO) .AND. 2 (STATUS.NE.SS$_CONTROLY) .AND. 3 (STATUS.NE.SS$_CONTROLC)) THEN RESULT = STATUS CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW failure writing to GOC terminal') END IF RETURN C--- ENTRY INGO03(INLUN) LUN=INLUN RETURN C--- END C********* SUBROUTINE GRGO10 C-------------------------------------------------------------------- C GRPCKG(GOC) Initialise the terminal. Note that the display C is NOT erased. C C Initialisation sequence contains - C C Graphics flag sequence C Allow any length graphics sequences C Graphics cursor off C Graphics display on C Alpha display on C Disable cursor prompt character. C Set full screen cursor C Recognise Graphics flag sequence any time in alpha mode C Return to alpha mode (appended by GRGO03) C C Note the way the GOC modes are controlled. Assuming that the GOC is in C reset or alpha mode initially, the initialisation sequence will leave it C in alpha mode. Outside the writing of GRPCKG buffers to the GOC, it is C left in alpha mode. Whenever a new buffer is started, it begins with C the graphics flag sequence and a pen down code(inserted by GRGO02). C Before a buffer is output, it is always terminated by a 'return to alpha C mode' command(inserted by GRGO03). Routines - such as GRCURS - that C have to write directly to the GOC should always flush out the buffer C first(using GRTERM) and make sure that they leave the GOC in alpha mode. C C( 4-Feb-1986 KS / AAO ) C-------------------------------------------------------------------- CHARACTER CR, LF PARAMETER (CR=CHAR(13),LF=CHAR(10)) C INTEGER ICNT CHARACTER GCINIT*27 DATA GCINIT/' +-*/DD000CBGAAAHE999CK1GH'/ C--- GCINIT(1:2)=CR//LF ICNT=LEN(GCINIT) CALL GRGO03(%ref(GCINIT),ICNT) C END C********* SUBROUTINE GRGO11(LUN,IX,IY,CH) C C GOC terminals: method is similar to that for Tektronix, C except that the control strings and reply are ASCII formatted C strings. C INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER RPR PARAMETER (RPR=IO$_READPROMPT+IO$M_NOFORMAT+ 1 IO$M_PURGE+IO$M_NOECHO+IO$M_TIMED) CHARACTER CR PARAMETER (CR=CHAR(13)) INTEGER WRT PARAMETER (WRT=IO$_WRITEVBLK+IO$M_NOFORMAT) C INTEGER LUN, IX, IY CHARACTER CH INTEGER IOSB(2),RESULT,IER, SYS$QIOW CHARACTER GCREP*9, GCROMP*20, GCEND*11 DATA GCROMP/'+-*/GICECAxxxyyyCFHF'/ DATA GCEND/'+-*/CECBGJBH'/ C--- WRITE(GCROMP(11:16),'(I3.3,I3.3)',IOSTAT=IER) 1 IX+100,IY+100 IX=LEN(GCROMP) RESULT = SYS$QIOW(,%VAL(LUN),%VAL(RPR),IOSB, 1 ,,%REF(GCREP),%VAL(9),%VAL(60),, 2 %REF(GCROMP),%VAL(LEN(GCROMP))) IF(RESULT.NE.SS$_NORMAL) THEN CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW error reading from GOC terminal') END IF IF(GCREP(8:8).EQ.CR) THEN CH = CHAR(0) READ(GCREP,'(I3,1X,I3)',IOSTAT=IER) IX,IY ELSE CH = GCREP(1:1) READ(GCREP,'(1X,I3,1X,I3)',IOSTAT=IER) IX,IY END IF RESULT = SYS$QIOW(,%VAL(LUN),%VAL(WRT),IOSB, 1 ,,%REF(GCEND),%VAL(LEN(GCEND)),,,,) IF(RESULT.NE.SS$_NORMAL) THEN CALL GRGMSG(RESULT) CALL GRQUIT('SYS$QIOW error writing to GOC terminal') END IF CALL INGO01 RETURN END C= 6, Return default physical size of plot. 60 RBUF(1)=0 pgplot/drivers/gvdriv.f010064400040640000322000000247320641627154400157010ustar00tjpcitmbr00000400000017C*GVDRIV -- PGPLOT Genicom printer driver -- PORTRAIT MODE C+ SUBROUTINE GVDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Genicom printer device. C C This driver is basically a copy of pxdriver.for with changes for C setting the genicom mode and scale. C Version 1.0 - 1990 Feb 12 - J. H. Trice. C======================================================================= C C Supported device: Genicom 4410 dot-matrix printer. C C Device type code: /VGENICOM. C C Default device name: PGPLOT.PRPLOT. C C Default view surface dimensions: 7.8in (horizontal) by 10.25in C (vertical). C C Resolution: 140 (x) x 144 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 197 bytes, with C embedded carriage-control characters. A full-page plot occupies C 600 512-byte blocks. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE= : 'VGENICOM (Genicom 4410 dot-matrix printer, portrait)') PARAMETER (DEFNAM='PGPLOT.PRPLOT') BYTE FF PARAMETER (FF=12) C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER BITMAP C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 1164 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 140.0 RBUF(2) = 144.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 1154 RBUF(3) = 0 RBUF(4) = 1500 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- dimensions of plot buffer BX = 194 ! 1164/6 BY = 1520 CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 RECL=195, 3 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER CLOSE (UNIT=UNIT, DISPOSE='DELETE') CALL GRFLUN(UNIT) END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE NPICT = NPICT+1 C% type *,'Begin picture',NPICT IF (NPICT.GT.1) WRITE (UNIT=UNIT) FF CALL GRGV03(BX*BY, %val(BITMAP), 'C0'X) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE CALL GRGV01(1, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE CALL GRGV01(0, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT CALL GRGV02(UNIT, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRGV01 -- PGPLOT Genicom printer driver, draw line C+ SUBROUTINE GRGV01 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BX,BY) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:5) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'01'x,'02'x,'04'x,'08'x,'10'x,'20'x/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = D IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .OR. 1 QMASK(MOD(KX,6)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .AND. 1 (.NOT.QMASK(MOD(KX,6))) XP = XP + XINC YP = YP + YINC END DO END IF END C*GRGV02 -- PGPLOT Genicom driver, copy bitmap to output file C+ SUBROUTINE GRGV02 (UNIT, BX, BY, BITMAP) INTEGER UNIT, BX, BY BYTE BITMAP(BX,BY) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE SUFFIX(3),PREGEN(10),POSTGEN(2) DATA SUFFIX/ 5, 13, 10/ DATA PREGEN/27, 91,52,59,54,59,53,113,27,80/ DATA POSTGEN/27, 92/ INTEGER I, J, K C C WRITE PREFIX TO PUT IN HIGH DENSITY GRAPHICS MODE C WRITE(UNIT=UNIT) PREGEN C C Write bitmap. C DO J=1,BY DO K=BX,2,-1 IF (BITMAP(K,J).NE.'C0'X) GOTO 10 END DO 10 WRITE (UNIT=UNIT) (BITMAP(I,J),I=1,K),SUFFIX END DO WRITE(UNIT=UNIT) POSTGEN C C Write blank plot lines to fill up page C END C*GRGV03 -- fill buffer with a specified character C+ SUBROUTINE GRGV03 (BUFSIZ,BUFFER,FILL) C C GRPCKG (internal routine): fill a buffer with a given character. C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C FILL (integer, input): the fill character. BUFSIZ bytes starting at C address BUFFER are set to contents of FILL. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE FILL BYTE BUFFER(BUFSIZ) C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END -------------- C 70 RBUF(1) = 1 pgplot/drivers/hidriv.f010064400040640000322000000131210552456010700156460ustar00tjpcitmbr00000400000017C*HIDRIV -- PGPLOT HIDMP plotter driver C+ SUBROUTINE HIDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Houston Instruments HIDMP pen plotter. C C Version 1.0 - 1987 May 26 - T. J. Pearson. C version 2.0 - 1992 Apr 7 - standard Fortran (TJP). C----------------------------------------------------------------------- CHARACTER*(*) DEVICE CHARACTER*(*) DEFNAM PARAMETER (DEVICE='HIDMP (Houston Instruments pen plotter)') PARAMETER (DEFNAM='pgplot.hiplot') CHARACTER*80 MSG CHARACTER*64 INSTR INTEGER IER, I0, J0, I1, J1, L, LASTI, LASTJ, UNIT INTEGER GROPTX C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = DEVICE LCHR = LEN(DEVICE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 4799 RBUF(3) = 0 RBUF(4) = 7199 RBUF(5) = 1 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 200.0 RBUF(2) = 200.0 RBUF(3) = 2 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C No thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 2099 RBUF(3) = 0 RBUF(4) = 1599 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 3 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN MSG = 'Cannot open plot file: '//CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF LASTI = -1 LASTJ = -1 WRITE (UNIT, '(A)') ';:H EC5 A ' RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE WRITE (UNIT, '(A)') 'H EL @ ' CLOSE (UNIT) CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE WRITE (UNIT, '(A)') 'EL ' WRITE (UNIT, '(A)') ';:H EC5 A ' RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) 121 CONTINUE IF ( (I0.NE.LASTI) .OR. (J0.NE.LASTJ) ) THEN CALL GRFAO('U #,# D #,# ', L, INSTR, I0, J0, I1, J1) ELSE CALL GRFAO('#,# ', L, INSTR, I1, J1, 0, 0) END IF WRITE (UNIT,'(A)') INSTR(1:L) LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) I0 = I1 J0 = J1 GOTO 121 C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C (Not implemented.) C 150 CONTINUE RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Null operation: buffering is not implemented.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE WRITE (UNIT, '(A)') CHR(:LCHR) LASTI = -1 RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in HI device driver: '//MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END pgplot/drivers/hpdriv.f010064400040640000322000000224700566742465300157010ustar00tjpcitmbr00000400000017 SUBROUTINE HPDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Hewlett Packard HP 7221 pen plotter. C----------------------------------------------------------------------- C Version 1.0 - 1987 May 26 - T. J. Pearson. C Version 1.1 - 1994 Dec 01 - TJP (revised for standard Fortran-77). C C----------------------------------------------------------------------- CHARACTER*(*) DEVICE, DEFNAM PARAMETER (DEVICE='HP7221 (Hewlett-Packard HP7221 pen plotter') PARAMETER (DEFNAM='pgplot.hpplot') CHARACTER*10 MSG CHARACTER*11 GRHPLI CHARACTER*5 GRHPCP CHARACTER*1 HPCOL(7) INTEGER IER, I0, J0, I1, J1, LASTI, LASTJ, UNIT, N1, N2, IC INTEGER GRHPNC INTEGER GROPTX DATA HPCOL /'A', 'B', 'C', 'D', 'D', 'B', 'C'/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = DEVICE LCHR = LEN(DEVICE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 16000 RBUF(3) = 0 RBUF(4) = 11400 RBUF(5) = 1 RBUF(6) = 7 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1016.0 RBUF(2) = 1016.0 RBUF(3) = 2 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C No thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 13208 RBUF(3) = 0 RBUF(4) = 10160 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 10 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE CALL GRGLUN(UNIT) IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) RBUF(1) = UNIT NBUF = 2 IF (IER.NE.0) THEN CALL GRWARN('Cannot open file for HP7221 plot') RBUF(2) = 0 RETURN END IF RBUF(2) = 1 LASTI = -1 LASTJ = -1 WRITE (UNIT, '(A)') CHAR(27)//'.(~W`o(B2H}vA}~So(B2H}p`}' WRITE (UNIT, '(A)') CHAR(27)//'.N0;19:' WRITE (UNIT, '(A)') CHAR(27)//'.I128;5;17:' RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE WRITE (UNIT, '(A)') 'po(B2H}v@'//CHAR(27)//'.)}' CLOSE (UNIT) CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE WRITE (UNIT,'(A)') 'po(B2H}v@'//CHAR(27)//'.)}' WRITE (UNIT,'(A)') CHAR(12) WRITE (UNIT,'(A)') CHAR(27)//'.(~W`o(B2H}~So(B2H}p`}' WRITE (UNIT,'(A)') CHAR(27)//'.N0;19:' WRITE (UNIT,'(A)') CHAR(27)//'.I128;5;17:' RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) 121 CONTINUE IF ( (I0.EQ.LASTI) .AND. (J0.EQ.LASTJ) ) THEN C -- pen down GRHPLI(1:1) = 'q' ELSE C -- pen up GRHPLI(1:1) = 'p' END IF C -- Encode the coordinate into the command string CALL GRHP02(I0,J0,GRHPCP,GRHPNC) N1 = GRHPNC + 1 IF (GRHPNC .GT. 0) GRHPLI(2:N1) = GRHPCP(1:GRHPNC) CALL GRHP02(I1,J1,GRHPCP,GRHPNC) N2 = GRHPNC + N1 IF (GRHPNC .GT. 0) GRHPLI(N1+1:N2) = GRHPCP(1:GRHPNC) C -- Write the command string to the plot file WRITE (UNIT,'(A)') CHAR(5)//GRHPLI(1:N2)//'}' LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) I0 = I1 J0 = J1 GOTO 121 C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE IC = NINT(RBUF(1)) IF (IC.LT.1) IC = 1 IF (IC.GT.7) IC = 1 WRITE (UNIT,'(A)') 'v'//HPCOL(IC)//'}' RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Null operation: buffering is not implemented.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE WRITE (UNIT, '(A)') CHR(:LCHR) LASTI = -1 RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in HP device driver: '//MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END SUBROUTINE GRHP02(GRHPNX,GRHPNY,GRHPCP,GRHPNC) C----------------------------------------------------------------------- C GRPCKG (internal routine, HP7221): C This subroutine translates the INTEGER coordinates into the C appropriate HP MBP format, and returns them as a single C character*5 string. C Reference: HP 7221B Graphics Plotter Operating and C Programming Manual, HP Part # 07221-90014 C C Arguments: GRHPNX : X coord of point in plotter units (<= 16383) C GRHPNY : ditto Y C GRHPCP : output character string with coded position C GRHPNC : number of bytes used in GRHPNC C C (18-July-1983, R. S. Simon) C----------------------------------------------------------------------- INTEGER GRHPNX, GRHPNY, GRHPNC, N, NX1, NX2, NX3, NXR INTEGER NY2, NY3, NY4, NY5, NYR, NP1, NP2, NP3, NP4, NP5 CHARACTER*5 GRHPCP C GRHPNC = 0 NP1 = 0 NP2 = 0 NP3 = 0 NP4 = 0 NP5 = 0 C IF (GRHPNX.LT.0.OR.GRHPNY.LT.0) THEN CALL GRWARN('GRHPNX and/or GRHPNY is <0. Point not coded.') RETURN END IF C N = MAX(GRHPNX,GRHPNY) C IF (N.GT.16383) THEN CALL GRWARN('GRHPNX and/or GRHPNY too big. Point not coded.') RETURN ELSE IF (N .GT. 2047) THEN GRHPNC = 5 NX1 = GRHPNX/1024 NXR = GRHPNX - 1024 * NX1 NX2 = NXR/16 NX3 = NXR - 16 * NX2 NY3 = GRHPNY/4096 NYR = GRHPNY - 4096 * NY3 NY4 = NYR/64 NY5 = NYR - 64 * NY4 NP1 = NX1 + 96 NP2 = NX2 IF (NP2.LE.31) NP2 = NP2 + 64 NP3 = NY3 + 4 * NX3 IF (NP3.LE.31) NP3 = NP3 + 64 NP4 = NY4 IF (NP4.LE.31) NP4 = NP4 + 64 NP5 = NY5 IF (NP5.LE.31) NP5 = NP5 + 64 ELSE IF (N .GT. 255) THEN GRHPNC = 4 NX1 = GRHPNX/128 NXR = GRHPNX - 128 * NX1 NX2 = NXR/2 NX3 = NXR - 2 * NX2 NY3 = GRHPNY/64 NY4 = GRHPNY - 64 * NY3 NP1 = NX1 + 96 NP2 = NX2 IF (NP2.LE.31) NP2 = NP2 + 64 NP3 = NY3 + 32 * NX3 IF (NP3.LE.31) NP3 = NP3 + 64 NP4 = NY4 IF (NP4.LE.31) NP4 = NP4 + 64 ELSE IF (N .GT. 31) THEN GRHPNC = 3 NX1 = GRHPNX/16 NX2 = GRHPNX - 16 * NX1 NY2 = GRHPNY/64 NY3 = GRHPNY - 64 * NY2 NP1 = NX1 + 96 NP2 = NY2 + 4 * NX2 IF (NP2.LE.31) NP2 = NP2 + 64 NP3 = NY3 IF (NP3.LE.31) NP3 = NP3 + 64 ELSE IF (N .GT. 3) THEN GRHPNC = 2 NX1 = GRHPNX/2 NX2 = GRHPNX - 2 *NX1 NP1 = NX1 + 96 NP2 = GRHPNY + 32 * NX2 IF (NP2.LE.31) NP2 = NP2 + 64 ELSE IF (N .GE. 0) THEN GRHPNC = 1 NP1 = GRHPNY + 96 + 4 * GRHPNX END IF C GRHPCP = CHAR(NP1)//CHAR(NP2)//CHAR(NP3)//CHAR(NP4)//CHAR(NP5) RETURN END pgplot/drivers/ladriv.f010064400040640000322000000340110641627120600156430ustar00tjpcitmbr00000400000017C*LADRIV -- PGPLOT Driver for SIXEL code C+ (tested on DEC LA50, should in practice work on a LA100 or LN03) SUBROUTINE LADRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR BYTE ESC/27/,FF/12/ LOGICAL ALLERR C C PGPLOT driver for LA50 (SIXEL) device. C C Version 1.0 - 1988 Dec - B. H. Toby C======================================================================= C C Supported device: DEC LA50 C C Device type code: /LA50 C C Default device name: LA50:PGPLOT.LAPLOT C C Default view surface dimensions: 9.5 in (horizontal) by 6 in (vertical). C Maximum view surface dimensions: (none) (horizontal) by 7.9 in (vertical). C Note: the 11 inch limit is software imposed. C C Resolution: 72 (x) x 144 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 80 bytes, with C "list" carriage-control. C C Obtaining hardcopy: C if the LA50 is connected to the user's VT2xx or VT3xx terminal C then the printer can be accessed by sending the file C directly to the terminal: use PGPLOT device TT:/LA50 C or DEFINE PGPLOT_LA50 TT: (be sure to do a SET TERM/FORM if C page spacing is important) C if the LA50 is attached to a different terminal port, e.g. TXZ99:, C which preferably has been set spooled, use PGPLOT device TXZ99:/LA50 C or DEFINE PGPLOT_LA50 TXZ99: (be sure that TXZ99 has been set C /FORM if page spacing is important) C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='LA50 (DEC LA50 printer)') PARAMETER (DEFNAM='PGPLOT_LA50:PGPLOT.LAPLOT') C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG C define pointers for dynamically allocated arrays (used with same names) INTEGER BITMAP,buf C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = -1 RBUF(3) = 0 RBUF(4) = 1140 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 72.0 RBUF(2) = 144.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) + 1 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 720 ! 10 inch RBUF(3) = 0 RBUF(4) = 1008 ! 7 inch NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE ALLERR = .TRUE. CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 IC = 1 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='LIST', 1 DEFAULTFILE=DEFNAM, STATUS='NEW', 3 FORM='FORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ENDIF INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, STATUS='KEEP') CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C Allocate space based on the actual size of the plot, since there is no C way to signal an error, if it is not possible to allocate the space C set a flag which prevents plotting C C dynamically allocate memory for the plot bitmap C -- dimensions of plot buffer BX = 2. + (RBUF(1)+5.)/6. ! (six bits encoded in each byte) BY = 2. + RBUF(2) IER = GRGMEM(BX*BY, BITMAP) IF (IER.NE.1) then CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot bitmap.') GOTO 92 ENDIF C allocate space for a buffer IER = GRGMEM(BY, BUF) IF (IER.NE.1) then CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) CALL GRWARN('Failed to deallocate plot bitmap.') GOTO 92 ENDIF ALLERR = .FALSE. IC = 1 NPICT = NPICT+1 C% type *,'Begin picture',NPICT C initialize the buffer CALL GRLA03(BX*BY, %val(BITMAP)) RETURN C error in space allocation 92 CALL GRWARN('Plot type has been set to /NULL.') CLOSE (UNIT=UNIT, STATUS='DELETE') CALL GRFLUN(UNIT) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IF (ALLERR) RETURN C note: the following routine is shared with the PRINTRONIX driver CALL GRLA02(1, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IF (ALLERR) RETURN C note: the following routine is shared with the PRINTRONIX driver CALL GRLA02(0, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT C IF (ALLERR) RETURN C Assume the LA50 is attached to a terminal, if so send the terminal C into CONTROLLER mode while sending the plot. The extra escape sequences C should not cause any problems if the LA50 is directly connected. C Put terminal into controller mode, then enter graphics mode. IF (NPICT.EQ.1) THEN WRITE (UNIT,'(5a)') ESC,'[5i',ESC,'Pq' ELSE C if this is not the first plot, insert a form feed to advance the page WRITE (UNIT,'(5a)') ESC,'[5i',FF,ESC,'Pq' ENDIF CALL GRLA01(UNIT, BX, BY, %val(BITMAP),%val(BUF)) C leave graphics mode; put terminal into normal mode WRITE (UNIT,'(4a)') ESC,CHAR(92),ESC,'[4i' C deallocate space for bitmap and buffer IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot bitmap.') END IF IER = GRFMEM(BY, BUF) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF ALLERR = .true. RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRLA01 -- PGPLOT LA50 driver, copy bitmap to output file C+ SUBROUTINE GRLA01 (UNIT, BX, BY, BITMAP, BUF) INTEGER UNIT, BX, BY BYTE BITMAP(BX,BY), BUF(BY) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C BUF (temp.) buffer used to compress line of print C----------------------------------------------------------------------- INTEGER I, J, K, JMAX, M, ndup, jj, XMAX C C Create SIXEL code and write bitmap to LA50, line by line. C C The x-axis is the direction that paper advances, each line C that is sent contains six rows of bits C C find last non-zero line DO K=BX,1,-1 XMAX = K DO J=1,by if (BITMAP(K,J) .ne. '00'X) goto 1 ENDDO ENDDO C process each line 1 DO K=1,XMAX C copy each column of the bitmap to the buffer, reversing the order C also find the last non-zero array element JMAX = 1 jj = 0 DO J=by,1,-1 jj = jj + 1 BUF(jj) = BITMAP(K,J) IF (BUF(jj) .NE.'00'X) JMAX = jj END DO C compress the line and send it to the printer M = 0 ndup = 1 do 10 i=1,JMAX C can the current character be compressed with the next? if (i .ne. JMAX) THEN C if the next character the same as current increment the counter and go on IF (BUF(i) .eq. BUF(i+1)) then ndup = ndup + 1 goto 10 ENDIF ENDIF C The next character is different from current or this is the last character. C How many characters are repeated? if (ndup .le. 4) then C if less than five, don't bother to compress do j = 1,ndup M = M + 1 BUF(M) = BUF(i)+63 enddo ndup = 1 goto 10 elseif (ndup .le. 9) then BUF(M+1) = 33 encode(1,31,BUF(M+2)) ndup 31 format(i1) M = M + 2 + 1 elseif (ndup .le. 99) then BUF(M+1) = 33 encode(2,32,BUF(M+2)) ndup 32 format(i2) M = M + 2 + 2 elseif (ndup .le. 999) then BUF(M+1) = 33 encode(3,33,BUF(M+2)) ndup 33 format(i3) M = M + 2 + 3 else BUF(M+1) = 33 encode(4,34,BUF(M+2)) ndup 34 format(i4) M = M + 2 + 4 endif BUF(M) = BUF(i)+63 ndup = 1 10 continue WRITE (UNIT,'(80a1)') (BUF(j),j=1,M),'-' END DO END C*GRLA02 -- PGPLOT Printronix driver, draw line C+ SUBROUTINE GRLA02 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BX,BY) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:5) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'01'x,'02'x,'04'x,'08'x,'10'x,'20'x/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = D IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .OR. 1 QMASK(MOD(KX,6)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .AND. 1 (.NOT.QMASK(MOD(KX,6))) XP = XP + XINC YP = YP + YINC END DO END IF END C*GRLA03 -- zero fill buffer C+ SUBROUTINE GRLA03 (BUFSIZ,BUFFER) C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL /0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END LE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ENDIF INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100pgplot/drivers/lhdriv.f010064400040640000322000000212700552456011100156500ustar00tjpcitmbr00000400000017C*LHDRIV -- PGPLOT device driver for MS-DOS machines running Lahey F77 C 32-bit FORTRAN C+ SUBROUTINE LHDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for IBM PC's and clones running Lahey F77 32-bit Fortran v5.0. C This driver will put the display into graphics mode, and calls to 'close' C the workstation will set it back into the previous mode (generally erasing C the display, so don't do it until you are really finished). C C This routine must be compiled and linked with the Lahey graphics C library GRAPH3 supplied with Lahey Fortran v4.0 or greater. C C Microsoft FORTRAN versions: C 1989-Nov-03 - Started work [AFT] C 1989-Apr-06 - Improved version [AFT] C 1991-Mar-13 - Added cursor routine [JHT] C Lahey FORTRAN versions: C 1991-Dec-28 - derived from Microsoft version [PAH] C----------------------------------------------------------------------- C C Supported device: IBM PC's and compatables C C Device type code: /LH C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Depends on monitor, typical 7x10 inches C C Resolution: Depends on graphics card. Tested with a 640x480 VGA card. C Driver should work with other graphics cards, however, expect to C tweak it a bit. C C Color capability: Color indices 0-15 are accepted. This version maps C the PGPLOT color indices into the IBM color indices for with the C default color most closely corresponds to the PGPLOT default color. C Thus, PGPLOT index 2 (red) maps to IBM index 12 (light red). C C Input capability: Graphics cursor implemented using Microsoft Mouse C or compatible, accessed through DOS calls. C C File format: None. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- CHARACTER CMSG*10 REAL A,B real xfac, yfac parameter (xfac=11.0/640.0, yfac=8.5/480.0) integer pencolour, pend, colourmap(0:15), ix, iy logical got_mouse save pencolour, pend DATA colourmap/ 0,15,12,10, 9,11,13,14, 6, 2, 3, 1, 5, 4, 8, 7/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260) IFUNC 900 WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in LAHEY device driver: '/ : /CMSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = 'LH' LCHR = 2 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE RBUF(1) = 0 RBUF(2) = 640.0 RBUF(3) = 0 RBUF(4) = 480.0 RBUF(5) = 0 RBUF(6) = 15.0 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. C 30 continue A = 640.0/9.5 RBUF(1) = A B = 480.0/7.5 RBUF(2) = B RBUF(3) = 1.0 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, No cursor, No dashed lines, No area fill, C No thick lines, No rectangle fill, No pixel primitives,) C 40 continue if (got_mouse()) then CHR = 'ICNNNNNNNN' else CHR = 'INNNNNNNNN' endif LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = ' ' LCHR = 1 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE RBUF(1) = 0 RBUF(2) = 640.0 RBUF(3) = 0 RBUF(4) = 480.0 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE RBUF(1) = 0 RBUF(2) = 1 NBUF = 2 IF(RBUF(3) .NE. 0.0) THEN PEND=1 ELSE PEND=0 END IF CALL PLOTS(0, 0, 18) RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE CALL PLOT(0, 0, 999) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF(PEND.EQ.0) THEN CALL PLOT(0, 0, -999) ENDIF PEND=0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE CALL PLOT(RBUF(1)*xfac, RBUF(2)*yfac, 3) CALL PLOT(RBUF(3)*xfac, RBUF(4)*yfac, 2) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE CALL SETPIX(RBUF(1)*xfac, RBUF(2)*yfac, pencolour) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (RBUF(1) .NE. 0.0) THEN CALL PLOT(0.0, 0.0, -999) ENDIF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 CONTINUE pencolour=MIN( MAX(0,NINT(RBUF(1))) ,15) pencolour=colourmap(pencolour) CALL NEWPEN(pencolour) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C C 170 CONTINUE ix = nint(rbuf(1)) iy = 479-nint(rbuf(2)) call show_mouse call put_mouse(ix,iy) call cursor_key(ix,iy,chr) rbuf(1) = ix rbuf(2) = 479-iy call hide_mouse RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE RETURN C C--- IFUNC=25, Set fill pattern. --------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels. ----------------------------------------- C 260 CONTINUE RETURN C----------------------------------------------------------------------- END logical function got_mouse() implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 0 ntrup = 51 call intrup(intary,ntrup) got_mouse = (eax .eq. 65535) return end subroutine show_mouse implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 1 ntrup = 51 call intrup(intary,ntrup) return end subroutine hide_mouse implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 2 ntrup = 51 call intrup(intary,ntrup) return end subroutine get_mouse(ix, iy, button) implicit none integer ix, iy, button integer*2 ntrup integer intary(9), eax integer*2 bx, cx, dx equivalence (eax,intary(1)), - (bx,intary(2)), - (cx,intary(3)), - (dx,intary(4)) eax = 3 ntrup = 51 call intrup(intary,ntrup) ix = cx iy = dx button = bx return end subroutine put_mouse(ix, iy) implicit none integer ix, iy integer*2 ntrup integer intary(9), eax integer*2 bx, cx, dx equivalence (eax,intary(1)), - (bx,intary(2)), - (cx,intary(3)), - (dx,intary(4)) eax = 4 cx = ix dx = iy ntrup = 51 call intrup(intary, ntrup) return end subroutine cursor_key(ix, iy, key) implicit none character*(*) key integer ix, iy, ikey, ib integer*2 ixkey ikey = ixkey() key = char(ikey) call get_mouse(ix, iy, ib) return end of plot. ------------------ C 60 CONTINUE RBUF(1) = 0 RBUF(2) = 640.0 RBUF(3) = 0 RBUF(4) = 480.0 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. --------------------pgplot/drivers/ttdriv.f010064400040640000322000001217300651076017400157050ustar00tjpcitmbr00000400000017C*TTDRIV -- PGPLOT Tektronix terminal drivers C+ SUBROUTINE TTDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Tektronix terminals and emulators. C C 1993 Jan 18 - T. J. Pearson. C 1993 Jun 24 - L. Staveley-Smith, minor alteration of C flush-buffer for better /tek C compatibility. Also added MODE 7 for C Visual 603's and MODE 8 for IBM-PCs C running as remote terminals using C Kermit version 3 (for DOS). C 1994 Dec 19 - TJP: better XTERM support. C 1994 Dec 29 - TJP: and Tek4100 support (MODE 9). C 1996 Apr 18 - TJP: prevent concurrent access. C 1998 Mar 09 - M. Zolliker: new MODE 10 for VersaTerm-PRO for Macintosh C C Supported device: C 1. Tektronix 4006/4010 storage-tube terminal; can be used with C emulators, but the options below take advantage of features not C present in the basic Tektronix terminal. C 2. GraphOn Corporation 200-series terminals. These emulate a C Tektronix-4010 with enhancements (selective erase, rectangle fill, C switch between Tek and VT100 modes). C 3. Digital Engineering, Inc., Retrographics modified VT100 C terminal (VT640). C 4. IRAF GTERM Tektronix terminal emulator, with color extensions. C 5. Xterm window on an X-window server. Emulates a Tektronix-4014, C with extensions (switch between Tek and VT100 windows). C 6. ZSTEM 240 and ZSTEM 4014 terminal emulators for the IBM PC and C clones. ZSTEM supports Tektronix 4014 emulation and the 4105 color C escape sequences. ZSTEM can be obtained from: KEA Systems Ltd., C 2150 West Broadway, Suite 412, Vancouver, British Columbia, Canada, C V6K 4L9. C 7.Visual-603 and 630 terminals. These are VT100/220 compatible C terminals with Tektronix 4010/4014 emulation (Visual Technology C Incorporated, 1703 Middlesex Street, Lowell, Mass 01851). The C Visual 630 has the capability of displaying dual text and graphics. C This feature is not used in this driver. Graphics mode is entered C automatically when the graph is drawn but only exited when PGPAGE C or PGEND is called. Therefore, for multiple plots interspersed C with text I/O, use PGPAGE at the end of each plot. This will prompt C for a carriage return before switching. If this is not done, C intervening text will appear on the graphics screen. Graphics mode C can be entered and exited from the setup menu, or by SHIFT-PF1. C Graphics extensions include rectangle fill, selective erase and C switch between Tek and VT100 modes. C 8.IBM PC's and compatibles running MS-Kermit 3 as a terminal emulator. C The video board is assumed to have sufficient memory to retain the C graphics image in memory when switched to text. This will be true C for VGA and EGA, but some early PCs might not be able to do this. C If Kermit is using full VGA resolution (ie SET TERMINAL GRAPHICS C VGA), there is not usually enough memory to store the full 480 C vertical lines, so the bottom few lines may disappear. Tektronix C enhancements include selective erase, colours, rectangle fill, and C switching between text and graphics mode. The cursor may be C operated with the mouse. Tested with Kermit version 3.1. C 9.Tektronix 4100 series color terminals (and emulators) C 10.Versaterm-PRO for Macintosh (Tek 4105 emulation). C C Device type codes: C 1. /TEK4010 Tektronix-4010 terminal C 2. /GF GraphOn terminal C 3. /RETRO Retrographics VT640 terminal C 4. /GTERM GTERM terminal emulator C 5. /XTERM XTERM terminal emulator C 6. /ZSTEM ZSTEM terminal emulator C 7. /V603 Visual V603 terminal C 8. /KRM3 Kermit 3 on IBM-PC C 9. /TK4100 Tektronix 4100 series terminals C 10. /VMAC VersaTerm-PRO for Macintosh C C Default device name: the logged-in terminal C /dev/tty (UNIX) C TT: (VMS) C C Default view surface dimensions: C Depends on monitor; nominally 8in (horizontal) by 6in (vertical). C C Resolution: C A standard Tektronix terminal displays a screen of 1024 pixels C (horizontal) by 780 pixels (vertical), with a nominal resolution C of 130 pixels per inch. The actual resolution may be less. C C Color capability: C /TEK4010, /XTERM: none; only color index 1 is available; selective C erase is not possible. Requests to draw in color index 0 are C ignored. C /GF, /RETRO, /V603: color indices 0 (erase, black) and 1 (bright: C usually white, green or amber) are supported. It is not C possible to change color representation. C /GTERM: color indices 0 to 15 are available and default to the C standard PGPLOT colors. The color representation can be changed. C /ZSTEM: color indices 0 to 7 are available and default to the C indicated in the ZSTEM setup menu (which default to the standard C PGPLOT colors). The color representation cannot be changed. C /KRM3: color indices 0 to 7 are the standard PGPLOT colors. Indices C 8 to 14 are also available, but are BRIGHT versions of 1 to 7, C and thus non-standard. Color representation can't be changed. C /TK4100: color indices 0-15. C /VMAC: color indices 0 to 15 are available and default to the C standard PGPLOT colors. The color representation can be changed. C Caution: this does not work reliably, owing to bugs (?) in C Versaterm. C C Input capability: C Depending on the emulation, the graphics cursor may be a pointer, C a small cross, or a crosshair across the entire screen. The user C positions the cursor using thumbwheels, mouse, trackball, or the C arrow keys on the keyboard. The user indicates that the cursor has C been positioned by typing any printable ASCII character on the C keyboard. Most control characters (eg, ^C) are intercepted by the C operating system and cannot be used. C C File format: C Binary byte stream. Under Unix, the output may be directed to C a file; under VMS, this is not possible: the output device must C be a terminal. C C Obtaining hardcopy: C C Environment variables: C None. C-- C Implementation Notes: C C Standard Tektronix codes: C graph mode: [GS]=char(29) C alpha mode: [US]=char(31) C The emulators provide various extensions to basic Tektronix C operation, using the following codes: C [SOH]=char(1), [STX]=char(2), [ETX]=char(3), C [DLE]=char(16), [CAN]=char(24), [ESC]=char(27) C C Enter Tektronix mode (from VT100 mode): C graphon: automatic on receipt of [GS] C gterm: [GS] C tek: not available C retro: automatic on receipt of [GS] C xterm: [ESC][?38h C zstem: [ESC][?38h C v603: [GS] C krm3: [ESC][?38h C Return to VT100 mode (from Tektronix mode): C graphon: [CAN] C gterm: [CAN] C tek: not available C xterm: [ESC][ETX] C zstem: [CAN] C v603: [CAN][ESC][?38l C krm3: [ESC][?38l C Rectangle fill: C graphon: draw the diagonal in special rectangle mode, C entered with [ESC][STX], exit with [ESC][ETX] C v603: bottom corner and rectangle width C krm3: bottom corner and rectangle width C vmac: use panel boundary commands [ESC]LP and [ESC]LE C Color index zero (erase): C graphon select erase: [ESC][DLE] C graphon unselect erase: [ESC][SOH] C retro,v603 select erase: [ESC]/1d C retro,v603 unselect erase: [ESC]/0d C krm3, select erase: [ESC][0;30m C krm3, unselect erase: [ESC][0;37m C----------------------------------------------------------------------- INTEGER NDEVS PARAMETER (NDEVS=10) INTEGER CAN, ESC, GS, US PARAMETER (CAN=24, ESC=27, GS=29, US=31) C CHARACTER*48 DEVICE(NDEVS) SAVE DEVICE CHARACTER*80 TEXT CHARACTER*32 CTMP, CADD, CSCR(4)*4 CHARACTER*500 CBUF SAVE CBUF INTEGER I, J, INTEN, I0, J0, I1, J1, LADD, LTMP, ICH, IER INTEGER XSIZE(NDEVS), YSIZE(NDEVS), MAXCI(NDEVS), I4014(NDEVS) SAVE XSIZE, YSIZE, MAXCI, I4014 INTEGER ICHAN, LASTI, LASTJ, NPAGE, ICI, LBUF, STATE SAVE ICHAN, LASTI, LASTJ, NPAGE, ICI, LBUF, STATE INTEGER GROTER INTEGER IBUF(4), ITOT LOGICAL APPEND SAVE APPEND REAL XRESLN(NDEVS), YRESLN(NDEVS) SAVE XRESLN, YRESLN REAL HUE,SAT,LIG LOGICAL SEFCOL SAVE SEFCOL C INTEGER IRGB(3,0:15), TKRGB(3,0:15) C DATA DEVICE(1) /'TEK4010 (Tektronix 4010 terminal)'/ DATA DEVICE(2) /'GF (GraphOn Tek terminal emulator)'/ DATA DEVICE(3) /'RETRO (Retrographics VT640 Tek emulator)'/ DATA DEVICE(4) /'GTERM (Color gterm terminal emulator)'/ DATA DEVICE(5) /'XTERM (XTERM Tek terminal emulator)'/ DATA DEVICE(6) /'ZSTEM (ZSTEM Tek terminal emulator)'/ DATA DEVICE(7) /'V603 (Visual 603 terminal)'/ DATA DEVICE(8) /'KRM3 (Kermit 3 IBM-PC terminal emulator)'/ DATA DEVICE(9) /'TK4100 (Tektronix 4100 terminals)'/ DATA DEVICE(10) /'VMAC (VersaTerm-PRO for Mac, Tek 4105)'/ C TEK GF RET GTER XTER ZSTE V603 KRM3 TK41 VMAC DATA XSIZE /1023,1023,1023,1023,1023,1023,1023,1023,1023,1023/ DATA YSIZE / 779, 779, 779, 779, 779, 779, 779, 779, 779, 779/ DATA MAXCI / 1, 1, 1, 15, 1, 7, 1, 14, 15, 15/ DATA XRESLN/130.,128.,128.,130.,128.,130.,115.,110.,100.,128./ DATA YRESLN/130.,130.,130.,130.,130.,130.,115.,110.,100.,128./ DATA I4014/ 0, 0, 0, 0, 1, 1, 0, 0, 1, 1/ DATA IRGB / 0, 0, 0, 255,255,255, 255, 0, 0, 0,255, 0, 1 0, 0,255, 0,255,255, 255, 0,255, 255,255, 0, 2 255,128, 0, 128,255, 0, 0,255,128, 0,128,255, 3 128, 0,255, 255, 0,128, 085,085,085, 170,170,170/ DATA TKRGB/ 0, 0, 0, 100,100,100, 100, 0, 0, 0,100, 0, 1 0, 0,100, 0,100,100, 100, 0,100, 100,100, 0, 2 100, 50, 0, 50,100, 0, 0,100, 50, 0, 50,100, 3 50, 0,100, 100, 0, 50, 33, 33, 33, 67, 67, 67/ DATA STATE/0/ C----------------------------------------------------------------------- C IF (MODE.LT.1 .OR. MODE.GT.NDEVS) CALL GRWARN('Error in GRTT00') GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,900,900, 2 210,900,900,240), IFUNC C -- Ignore unimplemented function 900 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CONTINUE CHR = DEVICE(MODE) LCHR = LEN(DEVICE(MODE)) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE RBUF(1) = 0 RBUF(2) = XSIZE(MODE) RBUF(3) = 0 RBUF(4) = YSIZE(MODE) RBUF(5) = 0 RBUF(6) = MAXCI(MODE) NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 CONTINUE RBUF(1) = XRESLN(MODE) RBUF(2) = YRESLN(MODE) RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor, No dashed lines, No areafill, C No thick lines, No markers; some varieties have rectangle fill) C 40 CONTINUE CHR = 'ICNNNNNNNN' IF (MODE.EQ.2 .OR. MODE.EQ.7 .OR. MODE.EQ.8) CHR(6:6) = 'R' IF (MODE.EQ.10) THEN C -- VMAC: rect. fill and wait before closing graph window CHR(6:6) = 'R' CHR(8:8) = 'V' ENDIF LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CONTINUE CALL GRTRML(CHR,LCHR) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE RBUF(1) = 0 RBUF(2) = XSIZE(MODE) RBUF(3) = 0 RBUF(4) = YSIZE(MODE) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 CONTINUE RBUF(1) = 2.0 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE C -- do nothing RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT Tektronix device is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF APPEND = RBUF(3) .NE. 0.0 RBUF(1) = 0.0 NBUF = 2 ICHAN = GROTER(CHR, LCHR) IF (ICHAN .LT. 0) THEN TEXT = 'Cannot open output device for plot type '// : DEVICE(MODE) CALL GRWARN(TEXT) RBUF(2) = 0.0 RETURN ELSE STATE = 1 RBUF(2) = 1.0 END IF LASTI = -1 LASTJ = -1 ICI = 1 NPAGE = 0 LBUF = 0 IF (.NOT.APPEND) THEN IF ( MODE.EQ.4 ) THEN C -- load gterm default color table. DO 91 I=0,15 CTMP(1:6) = CHAR(GS)//CHAR(ESC)//'TG14' LTMP = 6 CALL GRTT05(I, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- red CALL GRTT05(IRGB(1,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- green CALL GRTT05(IRGB(2,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- blue CALL GRTT05(IRGB(3,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD CTMP(LTMP+1:LTMP+1) = CHAR(US) LTMP = LTMP + 1 CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) 91 CONTINUE CALL GRTT02(ICHAN, MODE, CHAR(CAN), 1, CBUF, LBUF) ELSE IF (MODE.EQ.10) THEN C -- VMAC: put into Tek 4105 mode CTMP(1:5)=CHAR(ESC)//'%!1'//CHAR(GS) CALL GRTT02(ICHAN, MODE, CTMP, 5, CBUF, LBUF) SEFCOL = .TRUE. C -- set default color representation DO 92,I=0,15 CALL GRXHLS(IRGB(1,I)/255.,IRGB(2,I)/255.,IRGB(3,I)/255. : ,HUE,LIG,SAT) CALL GRTT06(I, NINT(HUE), NINT(LIG*100), NINT(SAT*100) : , CTMP, LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) 92 CONTINUE END IF END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE IF ( MODE.EQ.6 ) THEN C -- For zstem switch back to alpha mode at the last possible C moment. LTMP = 1 CALL GRWTER(ICHAN, CHAR(CAN), LTMP) ELSE IF ( MODE.EQ.7 ) THEN C -- For v603 switch back to alpha mode at the last possible C moment. CTMP(1:7) = CHAR(CAN)//CHAR(ESC)//CHAR(91)//CHAR(63)// : CHAR(51)//CHAR(56)//CHAR(108) LTMP=7 CALL GRWTER(ICHAN, CTMP, LTMP) ELSE IF (MODE.EQ.10) THEN C -- VMAC: put into VT100 Mode without window resize CTMP(1:5)=CHAR(GS)//CHAR(ESC)//'%!7' LTMP=5 CALL GRWTER(ICHAN, CTMP, LTMP) END IF CALL GRCTER(ICHAN) STATE = 0 RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE NPAGE = NPAGE+1 LASTI = -1 IF (.NOT.APPEND) THEN IF (MODE.EQ.5 .OR. MODE.EQ.6 .OR. MODE. EQ.8) THEN C -- xterm, zstem, krm3: select Tek mode, erase screen CTMP(1:1) = CHAR(ESC) CTMP(2:2) = CHAR(12) CALL GRTT02(ICHAN, MODE, CTMP, 2, CBUF, LBUF) ELSE IF (MODE.EQ.7) THEN C -- V603: select Tek mode CTMP(1:1) = CHAR(GS) CTMP(2:2) = CHAR(ESC) CTMP(3:3) = CHAR(12) CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) ELSE C -- erase graphics screen CTMP(1:1) = CHAR(GS) CTMP(2:2) = CHAR(ESC) CTMP(3:3) = CHAR(12) CTMP(4:4) = CHAR(CAN) CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF) END IF ELSE IF (MODE.EQ.8) THEN C -- krm3: enter graph mode without deleting screen CTMP(1:1) = CHAR(ESC) CTMP(2:2) = CHAR(91) CTMP(3:3) = CHAR(63) CTMP(4:4) = CHAR(51) CTMP(5:5) = CHAR(56) CTMP(6:6) = CHAR(104) CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF) ELSE IF (MODE.EQ.9) THEN C -- TK4100: put device in graphics mode, erase screen CTMP(1:1) = CHAR(ESC) CTMP(2:4) = '%!0' CTMP(5:5) = CHAR(ESC) CTMP(6:6) = CHAR(12) CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF) CTMP(1:1) = CHAR(ESC) CTMP(2:6) = 'RU1;4' CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF) C -- set default color representation DO 111 I=0,15 CTMP(1:5) = CHAR(ESC)//'TG14' LTMP = 5 CALL GRTT05(I, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- red CALL GRTT05(TKRGB(1,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- green CALL GRTT05(TKRGB(2,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- blue CALL GRTT05(TKRGB(3,I), CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) 111 CONTINUE C -- set color index 1 CTMP(1:1) = CHAR(ESC) CTMP(2:4) = 'ML1' CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF) END IF RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C (omitted for color 0 on devices without selective erase) C 120 CONTINUE IF (ICI.EQ.0 .AND. (MODE.EQ.1 .OR. MODE.EQ.5)) RETURN IF ( I4014(MODE).EQ.0 ) THEN I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) ELSE I0 = NINT(4.*RBUF(1)) J0 = NINT(4.*RBUF(2)) I1 = NINT(4.*RBUF(3)) J1 = NINT(4.*RBUF(4)) END IF CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ, : I0, J0, I1, J1, CBUF, LBUF) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C (omitted for color 0 on devices without selective erase) C 130 CONTINUE IF (ICI.EQ.0 .AND. (MODE.EQ.1 .OR. MODE.EQ.5)) RETURN IF ( I4014(MODE).EQ.0 ) THEN I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) ELSE I0 = NINT(4.*RBUF(1)) J0 = NINT(4.*RBUF(2)) END IF CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ, : I0, J0, I0, J0, CBUF, LBUF) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (MODE.EQ.7) THEN C -- V603: enter alphanumerics and unset graphics CTMP(1:7) = CHAR(CAN)//CHAR(ESC)//CHAR(91)//CHAR(63)// : CHAR(51)//CHAR(56)//CHAR(108) LTMP=7 CALL GRWTER(ICHAN, CTMP, LTMP) ELSE IF (MODE.EQ.8) THEN C -- krm3: enter alphanumerics and unset graphics CTMP(1:6) = CHAR(ESC)//CHAR(91)//CHAR(63)// : CHAR(51)//CHAR(56)//CHAR(108) LTMP=6 CALL GRWTER(ICHAN, CTMP, LTMP) ELSE IF (MODE.EQ.9 .OR. MODE.EQ.10) THEN C -- TK4100, VMAC: return to text mode CTMP(1:1) = CHAR(ESC) CTMP(2:4) = '%!1' LTMP=4 CALL GRWTER(ICHAN, CTMP, LTMP) END IF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE ICI = RBUF(1) IF (ICI.LT.0 .OR. ICI.GT.MAXCI(MODE)) THEN ICI = 1 RBUF(1) = ICI END IF LASTI = -1 IF (MODE.EQ.2) THEN C -- GraphOn CTMP(1:1) = CHAR(GS) CTMP(2:2) = CHAR(ESC) CTMP(3:3) = CHAR(1) IF (ICI.EQ.0) CTMP(3:3) = CHAR(16) CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) ELSE IF (MODE.EQ.3 .OR. MODE.EQ.7) THEN C -- Retrographics, V603 CTMP(1:1) = CHAR(GS) CTMP(2:2) = CHAR(ESC) CTMP(3:3) = CHAR(47) CTMP(4:4) = CHAR(49-ICI) CTMP(5:5) = CHAR(100) CALL GRTT02(ICHAN, MODE, CTMP, 5, CBUF, LBUF) ELSE IF ( MODE.EQ.4 .OR. MODE.EQ.6 .OR. MODE.EQ.10) THEN C -- gterm and zstem, VMAC CTMP(1:4) = CHAR(GS)//CHAR(ESC)//'ML' CALL GRTT02(ICHAN, MODE, CTMP, 4, CBUF, LBUF) CALL GRTT05(ICI, CTMP, LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) SEFCOL=.TRUE. ELSE IF (MODE.EQ.9) THEN C -- TK4100 CTMP(1:3) = CHAR(ESC)//'ML' CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) CALL GRTT05(ICI, CTMP, LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) ELSE IF( MODE.EQ.8) THEN C -- krm3: all attributes off CTMP(1:1) = CHAR(27) CTMP(2:2) = CHAR(91) CTMP(3:3) = CHAR(48) CTMP(4:4) = CHAR(59) C C Load color definitions (8-14 are bold versions of 1-7, so are not the C standard PGPLOT ones) C IF ( ICI.EQ.0 ) I=0 IF ( ICI.EQ.1 .OR. ICI.EQ.8) I=7 IF ( ICI.EQ.2 .OR. ICI.EQ.9) I=1 IF ( ICI.EQ.3 .OR. ICI.EQ.10) I=2 IF ( ICI.EQ.4 .OR. ICI.EQ.11) I=4 IF ( ICI.EQ.5 .OR. ICI.EQ.12) I=6 IF ( ICI.EQ.6 .OR. ICI.EQ.13) I=5 IF ( ICI.EQ.7 .OR. ICI.EQ.14) I=3 CTMP(5:5) = CHAR(51) CTMP(6:6) = CHAR(48+I) IF (ICI.GT.7) THEN CTMP(7:7) = CHAR(59) CTMP(8:8) = CHAR(49) CTMP(9:9) = CHAR(109) CALL GRTT02(ICHAN, MODE, CTMP, 9, CBUF, LBUF) ELSE CTMP(7:7) = CHAR(109) CALL GRTT02(ICHAN, MODE, CTMP, 7, CBUF, LBUF) END IF END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (MODE.EQ.1 .OR. MODE.GT.5) THEN C -- tek4010, zstem, v603, krm3, or tk4100 CTMP(1:6) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)// : CHAR(64)//CHAR(US) CALL GRTT02(ICHAN, MODE, CTMP, 6, CBUF, LBUF) ELSE IF (MODE.EQ.5) THEN C -- xterm CTMP(1:3) = CHAR(US)//CHAR(ESC)//CHAR(3) CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) ELSE CTMP(1:8) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)// : CHAR(64)//CHAR(3)//CHAR(CAN)//CHAR(US) CALL GRTT02(ICHAN, MODE, CTMP, 8, CBUF, LBUF) END IF CALL GRWTER(ICHAN, CBUF, LBUF) LASTI = -1 RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C 170 CONTINUE C -- flush buffer CALL GRWTER(ICHAN, CBUF, LBUF) LASTI = -1 IF ( MODE.EQ.5 .OR. MODE.EQ.6 ) THEN C -- xterm and zstem make sure terminal is in Tektronix mode. LTMP = 6 CALL GRWTER(ICHAN, CHAR(ESC)//'[?38h', LTMP) END IF C -- initial cursor position I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) C -- read cursor CALL GRTT03(ICHAN, I0, J0, ICH, IER) C -- on XTERM, map mouse button clicks onto A, D, X. IF (MODE.EQ.5) THEN IF (ICH.EQ.236) THEN ICH = ICHAR('a') ELSE IF (ICH.EQ.237) THEN ICH = ICHAR('d') ELSE IF (ICH.EQ.242) THEN ICH = ICHAR('x') ELSE IF (ICH.EQ.204) THEN ICH = ICHAR('A') ELSE IF (ICH.EQ.205) THEN ICH = ICHAR('D') ELSE IF (ICH.EQ.210) THEN ICH = ICHAR('X') END IF END IF C -- return result IF (IER.EQ.0) THEN RBUF(1) = I0 RBUF(2) = J0 CHR(1:1) = CHAR(ICH) ELSE CHR(1:1) = CHAR(0) END IF NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE IF (MODE.EQ.2 .OR. MODE.EQ.3) THEN C -- GraphOn, Retrographics: return to VT100 mode and C issue VT100 erase-screen command CTMP(1:8) = CHAR(GS)//CHAR(55)//CHAR(127)//CHAR(32)// : CHAR(64)//CHAR(3)//CHAR(CAN)//CHAR(US) CALL GRTT02(ICHAN, MODE, CTMP, 8, CBUF, LBUF) CTMP(1:7) = CHAR(ESC)//'[2J'//CHAR(ESC)//'[H' CALL GRTT02(ICHAN, MODE, CTMP, 7, CBUF, LBUF) LASTI = -1 END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (MODE.EQ.4) THEN C -- gterm I = RBUF(1) CTMP(1:6) = CHAR(GS)//CHAR(ESC)//'TG14' LTMP = 6 CALL GRTT05(I, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- red INTEN = RBUF(2)*255.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- green INTEN = RBUF(3)*255.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- blue INTEN = RBUF(4)*255.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C CTMP(LTMP+1:LTMP+2) = CHAR(US)//CHAR(CAN) LTMP = LTMP + 2 CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) CALL GRWTER(ICHAN, CBUF, LBUF) LASTI = -1 ELSE IF (MODE.EQ.9) THEN C -- TK4100 I = RBUF(1) CTMP(1:5) = CHAR(ESC)//'TG14' LTMP = 5 CALL GRTT05(I, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- red INTEN = RBUF(2)*100.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- green INTEN = RBUF(3)*100.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD C -- blue INTEN = RBUF(4)*100.0 CALL GRTT05(INTEN, CADD, LADD) CTMP(LTMP+1:LTMP+LADD) = CADD(:LADD) LTMP = LTMP + LADD CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) CALL GRWTER(ICHAN, CBUF, LBUF) LASTI = -1 ELSE IF (MODE.EQ.10) THEN C -- VersaTerm CTMP(1:1)=CHAR(GS) CALL GRTT02(ICHAN, MODE, CTMP, 1, CBUF, LBUF) CALL GRXHLS(RBUF(2), RBUF(3), RBUF(4), HUE, LIG, SAT) CALL GRTT06(NINT(RBUF(1)) : , NINT(HUE), NINT(LIG*100), NINT(SAT*100), CTMP, LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) CALL GRWTER(ICHAN, CBUF, LBUF) LASTI = -1 END IF RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE IF ( I4014(MODE).EQ.0 ) THEN I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) ELSE I0 = NINT(4.*RBUF(1)) J0 = NINT(4.*RBUF(2)) I1 = NINT(4.*RBUF(3)) J1 = NINT(4.*RBUF(4)) END IF IF (MODE.EQ.2) THEN C -- GraphOn C -- enter rectangle mode CALL GRTT02(ICHAN, MODE, CHAR(GS)//CHAR(ESC)//CHAR(2), 3, : CBUF, LBUF) C -- draw rectangle CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ, : I0, J0, I1, J1, CBUF, LBUF) C -- exit rectangle mode CALL GRTT02(ICHAN, MODE, CHAR(ESC)//CHAR(3), 2, CBUF, LBUF) ELSE IF (MODE.EQ.7 .OR. MODE.EQ.8) THEN C -- v603, krm3: needs bottom left corner and rectangle C dimensions IBUF(1)=I0+1 IBUF(2)=J0+1 IBUF(3)=I1+1 IBUF(4)=J1+1 DO 241 I=1,4 IF (IBUF(I) .LT. 1) IBUF(I)=1 IF (IBUF(I) .GT. 1056) IBUF(I)=1056 241 CONTINUE IBUF(3)=IBUF(3)-IBUF(1) IBUF(4)=IBUF(4)-IBUF(2) ITOT=0 DO 244 I=1,4 WRITE (CSCR(I)(1:4), '(I4)') IBUF(I) IBUF(I)=1 DO 242 J=1,4 IF (CSCR(I)(J:J) .NE. ' ') THEN GOTO 243 END IF IBUF(I)=IBUF(I)+1 242 CONTINUE 243 CONTINUE ITOT=ITOT+5-IBUF(I) 244 CONTINUE CTMP(1:8+ITOT)= : CHAR(ESC)//CHAR(47)//CSCR(1)(IBUF(1):4)//CHAR(59)// : CSCR(2)(IBUF(2):4)//CHAR(59)//CSCR(3)(IBUF(3):4)// : CHAR(59)//CSCR(4)(IBUF(4):4)//CHAR(59)//CHAR(49)// : CHAR(121) CALL GRTT02(ICHAN, MODE, CTMP, 8+ITOT, CBUF, LBUF) ELSE IF (MODE.EQ.10) THEN C -- VMAC: use polygon fill commands IF (SEFCOL) THEN C set fill color SEFCOL=.FALSE. CTMP(1:3) = CHAR(ESC)//'MP' CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) CALL GRTT05(-ICI, CTMP, LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) ENDIF C send "start polygon fill" CTMP(1:3) = CHAR(ESC)//'LP' LTMP=3 C make lasti,lastj different from i0,j0 in each bit LASTI=4095-I0 LASTJ=4095-J0 C send first coordinate CALL GRTT04(I4014(MODE), LASTI, LASTJ, I0, J0, CTMP, LTMP) LASTI=I0 LASTJ=J0 C '0' means: boundary has the same the color as fill area CTMP(LTMP+1:LTMP+1)='0' LTMP=LTMP+1 CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) C further edges: CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ, : I0, J1, I1, J1, CBUF, LBUF) CALL GRTT01(ICHAN, MODE, I4014(MODE), LASTI, LASTJ, : I1, J1, I1, J0, CBUF, LBUF) C send "end polygon fill" CTMP(1:3)=CHAR(ESC)//'LE' CALL GRTT02(ICHAN, MODE, CTMP, 3, CBUF, LBUF) END IF RETURN C----------------------------------------------------------------------- END C*GRTT01 -- PGPLOT Tektronix driver, draw line segment C+ SUBROUTINE GRTT01(ICHAN, MODE, I4014, LASTI, LASTJ, I0, J0, : I1, J1, CBUF, LBUF) INTEGER ICHAN, MODE, I4014, LASTI, LASTJ, I0, J0, I1, J1, LBUF CHARACTER CBUF*(*) C C This routine draws a line from (I0, J0) to (I1, J1). If LASTI>=0 C assume that the cursor is at the position is at (LASTI, LASTJ). C For this case, a minimum length move is done from (LASTI, LASTJ) to C the nearer point. Of course, if (LASTI, LASTJ) and the nearer point C are the same, then no bytes of positioning data are generated and C sent to the terminal. If LASTI<0 then a move is done with the C coordinate fully specified. In both cases the line end point C is specified using the fewest number of bytes allowed by the protocol. C Upon return, LASTI,LASTJ will contain the current cursor position. C If I4014=0 then 10 bit (4010) coordinates are generated, for I4014=1, C full 12 bit Tektronix (4014 and higher) coordinates are generated. C Note: The 'delete' character (127) can occur in LOY or EXTRA byte; C it can be replaced by escape-? if desired. C C Arguments: C ICHAN (in) : passed to GRTT02 if called. C MODE (in) : passed to GRTT02 if called. C I4014 (in) : =0 generate 4010 coords, =1 generate 4014. C LASTI,LASTJ (in/out) : current position C I0, J0 (in/out) : device coordinates of the starting point. C I1, J1 (in/out) : device coordinates of the end point. C CBUF (in/out) : buffer for instruction. C LBUF (in/out) : Number of valid characters in CBUF. C C 1993-Feb-02 - Created from GRZS01 - [AFT] C----------------------------------------------------------------------- INTEGER GS PARAMETER (GS = 29) INTEGER MASKLX, MASKHX PARAMETER (MASKLX = 64, MASKHX = 32) INTEGER MASKLY, MASKHY PARAMETER (MASKLY = 96, MASKHY = 32) INTEGER MASKEX PARAMETER (MASKEX = 96) C CHARACTER CTMP*12 INTEGER ID0, ID1, IFLUSH, ITMP INTEGER IEX, ILOX, IHIX, ILOY, IHIY, LTMP C C If it is possible for this routine to generate enough data to fill C the buffer, and thus cause it to be flushed to the terminal, then we C force the write to take place now. This will ensure that terminal C is in the correct state for the following commands. IF ( LBUF+11.GE.LEN(CBUF) ) THEN CALL GRWTER(ICHAN, CBUF, LBUF) IFLUSH = 1 ELSE IFLUSH = 0 END IF C LTMP = 0 IF(LASTI.LT.0) THEN C Last position is invalid, therefore do a dark vector move with all C coordinates specified. LTMP=LTMP+1 CTMP(LTMP:LTMP)=CHAR(GS) IF ( I4014.EQ.0 ) THEN IHIY = J0/32 ILOY = MOD(J0, 32) IHIX = I0/32 ILOX = MOD(I0, 32) CTMP(LTMP+1:LTMP+4) = : CHAR( MASKHY + IHIY )// : CHAR( MASKLY + ILOY )// : CHAR( MASKHX + IHIX )// : CHAR( MASKLX + ILOX ) LTMP = LTMP + 4 ELSE IHIY = J0/128 ILOY = MOD(J0/4, 32) IHIX = I0/128 ILOX = MOD(I0/4, 32) IEX = 4*MOD(J0, 4) + MOD(I0, 4) CTMP(LTMP+1:LTMP+5) = : CHAR( MASKHY + IHIY )// : CHAR( MASKEX + IEX )// : CHAR( MASKLY + ILOY )// : CHAR( MASKHX + IHIX )// : CHAR( MASKLX + ILOX ) LTMP = LTMP + 5 END IF ELSE C Last position is valid, move pen to nearest end point of line. ID0=ABS(LASTI-I0)+ABS(LASTJ-J0) ID1=ABS(LASTI-I1)+ABS(LASTJ-J1) IF(ID1.LT.ID0) THEN C Swap coordinates to minimize 'pen motion'. For optimized coordinates C this can reduce the amount of I/O to the the terminal. ITMP=I0 I0=I1 I1=ITMP ITMP=J0 J0=J1 J1=ITMP ITMP=ID0 ID0=ID1 ID1=ITMP END IF IF(ID0.NE.0 .OR. ID1.NE.0) THEN C Position has changed, so do a move operation. LTMP=LTMP+1 CTMP(LTMP:LTMP)=CHAR(GS) CALL GRTT04(I4014,LASTI,LASTJ,I0,J0,CTMP,LTMP) ELSE IF(IFLUSH.NE.0) THEN C The position is valid, but the buffer was flushed, so terminal may C no longer be in graph mode. Therefore, send GS and followed by a C zero length dark move (i.e., just resend LOX coordinate). IF ( I4014.EQ.0 ) THEN ILOX = MOD(I0, 32) ELSE ILOX = MOD(I0/4, 32) END IF CTMP(LTMP+1:LTMP+2)=CHAR(GS)//CHAR(MASKLX+ILOX) LTMP=LTMP+2 END IF END IF END IF C C Terminal is now in graph mode, and the `pen' has been positioned. C Do an optimized draw. CALL GRTT04(I4014,I0,J0,I1,J1,CTMP,LTMP) CALL GRTT02(ICHAN, MODE, CTMP, LTMP, CBUF, LBUF) C C Remember current position. LASTI=I1 LASTJ=J1 RETURN C END C*GRTT02 -- PGPLOT Tektronix driver, transfer data to buffer C+ SUBROUTINE GRTT02 (ICHAN, MODE, CADD, LADD, CBUF, LBUF) INTEGER ICHAN, MODE, LADD, LBUF CHARACTER CADD*(*), CBUF*(*) C C Arguments: C ICHAN (input) : channel number for output (when buffer is full). C MODE (input) : emulation type. C CADD (input) : text to add to buffer. C LADD (input) : number of characters to transfer. C CBUF (input) : output buffer. C LBUF (in/out) : number of valid characters in CBUF. C C Subroutines called: C GRWTER C----------------------------------------------------------------------- IF (LBUF+LADD.GE.LEN(CBUF) ) THEN CALL GRWTER(ICHAN, CBUF, LBUF) END IF C IF ( LADD.GT.0 ) THEN IF ( LBUF.EQ.0 ) THEN IF ( MODE.EQ.5 .OR. MODE.EQ.6 ) THEN CBUF(1:6) = CHAR(27)//'[?38h' LBUF = 6 END IF END IF CBUF(LBUF+1:LBUF+LADD) = CADD(1:LADD) LBUF = LBUF + LADD END IF C----------------------------------------------------------------------- END C*GRTT03 -- PGPLOT Tektronix driver, cursor routine C+ SUBROUTINE GRTT03 (ICHAN, IX, IY, IC, IER) INTEGER ICHAN, IX, IY, IC, IER C C Arguments: C ICHAN (input) : channel for output to device. C IX, IY (in/out) : initial/final coordinates of cursor (device C coordinates). C IC (output) : character code. C IER (output) : error status (0 is OK). C C----------------------------------------------------------------------- CHARACTER CBUF*8, CPROM*10 INTEGER I1, I2, LBUF C C Position cursor (by drawing a dark vector). C CPROM(1:1) = CHAR(29) CPROM(2:2) = CHAR(32+(IY/32)) CPROM(3:3) = CHAR(96+MOD(IY,32)) CPROM(4:4) = CHAR(32+(IX/32)) CPROM(5:5) = CHAR(64+MOD(IX,32)) CPROM(6:6) = CHAR(27) CPROM(7:7) = CHAR(47) CPROM(8:8) = CHAR(102) CPROM(9:9) = CHAR(27) CPROM(10:10) = CHAR(26) C C Do a read with prompt. C LBUF = 5 CALL GRPTER(ICHAN, CPROM, 10, CBUF, LBUF) C C Must read at least 5 characters. C IF( LBUF.LT.5) THEN IER = 1 ELSE C C Decode coordinates. C IC = ICHAR( CBUF(1:1) ) I1 = MOD( ICHAR(CBUF(2:2)), 32 ) I2 = MOD( ICHAR(CBUF(3:3)), 32 ) IX = I1*32 + I2 I1 = MOD( ICHAR(CBUF(4:4)), 32 ) I2 = MOD( ICHAR(CBUF(5:5)), 32 ) IY = I1*32 + I2 IER = 0 END IF RETURN C----------------------------------------------------------------------- END C*GRTT04 -- PGPLOT Tektronix driver, encode coordinate pair, optimize C+ SUBROUTINE GRTT04(I4014, LASTI, LASTJ, I0, J0, CTMP, LTMP) INTEGER I4014, LASTI, LASTJ, I0, J0, LTMP CHARACTER CTMP*(*) C C Assume cursor is at position LASTI, LASTJ and that the light or C dark vector condition has been correctly set. Add up to 5 characters C to CTMP to draw a vector to I0, J0. The minimum number of characters C are encoded to obtain the motion. C----------------------------------------------------------------------- INTEGER MASKLX, MASKHX PARAMETER (MASKLX = 64, MASKHX = 32) INTEGER MASKLY, MASKHY PARAMETER (MASKLY = 96, MASKHY = 32) INTEGER MASKEX PARAMETER (MASKEX=96) C INTEGER IEX, ILOX, IHIX, ILOY, IHIY INTEGER LEX, LLOX, LHIX, LLOY, LHIY C IF ( I4014.EQ.0 ) THEN LHIY = LASTJ/32 LLOY = MOD(LASTJ, 32) LHIX = LASTI/32 LLOX = MOD(LASTI, 32) LEX = 0 IHIY = J0/32 ILOY = MOD(J0, 32) IHIX = I0/32 ILOX = MOD(I0, 32) IEX = 0 ELSE LHIY = LASTJ/128 LLOY = MOD(LASTJ/4, 32) LHIX = LASTI/128 LLOX = MOD(LASTI/4, 32) LEX = 4*MOD(LASTJ, 4) + MOD(LASTI, 4) IHIY = J0/128 ILOY = MOD(J0/4, 32) IHIX = I0/128 ILOX = MOD(I0/4, 32) IEX = 4*MOD(J0, 4) + MOD(I0, 4) END IF C IF(IHIY.NE.LHIY) THEN LTMP=LTMP+1 CTMP(LTMP:LTMP) = CHAR(32+IHIY) END IF C Note, for 4010 mode, IEX=LEX (by definition) IF(IEX.NE.LEX) THEN LTMP=LTMP+1 CTMP(LTMP:LTMP) = CHAR(96+IEX) END IF IF(IEX.NE.LEX .OR. ILOY.NE.LLOY .OR. IHIX.NE.LHIX) THEN LTMP=LTMP+1 CTMP(LTMP:LTMP) = CHAR(96+ILOY) END IF IF(IHIX.NE.LHIX) THEN LTMP=LTMP+1 CTMP(LTMP:LTMP) = CHAR(32+IHIX) END IF LTMP=LTMP+1 CTMP(LTMP:LTMP) = CHAR(64+ILOX) RETURN END C*GRTT05 -- PGPLOT Tektronix 4100 driver, encode integer C+ SUBROUTINE GRTT05(I, C, NC) INTEGER I CHARACTER*(*) C INTEGER NC C C Encode integer in host syntax. Input integer I; output encoded string C C, containing NC characters (1, 2, or 3). This version encodes C integers up to 1023, which fit in two characters. C----------------------------------------------------------------------- INTEGER J C J = IABS(I) IF (J.LT.16) THEN IF (I.LT.0) THEN C(1:1) = CHAR(J+32) ELSE C(1:1) = CHAR(J+48) END IF NC = 1 ELSE C(1:1) = CHAR(J/16+64) IF (I.LT.0) THEN C(2:2) = CHAR(MOD(J,16)+32) ELSE C(2:2) = CHAR(MOD(J,16)+48) END IF NC = 2 END IF C END C*GRTT06 -- PGPLOT Tektronix 4100 driver, encode color definition C+ SUBROUTINE GRTT06(IDX, I1, I2, I3, C, NC) INTEGER ESC, GS, US PARAMETER (ESC=27, GS=29, US=31) INTEGER IDX, I1, I2, I3 CHARACTER*(*) C INTEGER NC C C Encode color definition, Color index IDX, I1,I2,I3 are the 3 integer C color components (definiton is device-dependent). C output encoded string containing NC characters (max 20). C----------------------------------------------------------------------- INTEGER L C C(1:5) = CHAR(ESC)//'TG14' NC=5 CALL GRTT05(IDX, C(NC+1:NC+3), L) NC=NC+L CALL GRTT05(I1, C(NC+1:NC+3), L) NC=NC+L CALL GRTT05(I2, C(NC+1:NC+3), L) NC=NC+L CALL GRTT05(I3, C(NC+1:NC+3), L) NC=NC+L END DE (in) : passed to GRTT02 ifpgplot/drivers/ljdriv.f010064400040640000322000000751020670245143300156620ustar00tjpcitmbr00000400000017C*LJDRIV -- PGPLOT Hewlett Packard LaserJet driver C+ SUBROUTINE LJDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Hewlett packard Laserjet device. C C Version 1.0 - 1989 Apr 09 - S. C. Allendorf C Combined all drivers into one driver that C uses a logical name to choose the format. C TJP 1997-Jul-24: replaced ENCODE with WRITE, but still VMS-specific. C======================================================================= C C Supported device: Hewlett Packard LaserJet, LaserJet+, or LaserJet II. C C Device type code: /LJnn where nn is a number 1 - NDEV inclusive. C C Default device name: PGPLOT.LJPLT. C C Default view surface dimensions: Depends on which version of the driver C is chosen via the logical name PGPLOT_LJ_MODE. C C Driver Equivalence Size (H x V) C ------ ----------- --------------------- C LJ01 LHOR 10.50 by 8.00 inches C LJ02 PHOR 8.00 by 10.50 inches C LJ03 PHOT 8.00 by 10.50 inches C LJ04 LHBR 6.54 by 4.91 inches C LJ05 PHBS 5.65 by 5.65 inches C LJ06 LMBR 10.50 by 8.00 inches C LJ07 PMBR 8.00 by 10.50 inches C LJ08 PMBS 4.48 by 4.48 inches C LJ09 PLBS 6.00 by 6.00 inches C C Resolution: Depends on which version of the driver is chosen via the C logical name PGPLOT_LJ_MODE. C C Driver Equivalence Resolution C ------ ----------- ---------- C LJ01 LHOR 300 DPI C LJ02 PHOR 300 DPI C LJ03 PHOT 300 DPI C LJ04 LHBR 300 DPI C LJ05 PHBS 300 DPI C LJ06 LMBR 150 DPI C LJ07 PMBR 150 DPI C LJ08 PMBS 150 DPI C LJ09 PLBS 100 DPI C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: See the LaserJet Printer Technical Reference Manual for C details of the file format. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C----------------------------------------------------------------------- C C To choose one of the specific LaserJet drivers, you must execute a DCL C command of the following form before executing your program: C C $ DEFINE PGPLOT_LJ_MODE LJnn C C where nn is a number 1 - NDEV inclusive. You may also use one of the C equivalent names listed above. These equivalent names are an attempt C to make the driver names make sense. They are decoded as follows: C C 1st character: P for protrait orientation or C L for landscape orientation. C 2nd character: H for high resolution (300 dpi) or C M for medium resolution (150 dpi) or C L for low resolution (100 dpi). C 3rd character: B for a straight bitmap dump (subroutine GRLJ01) or C O for an optimized bitmap dump (subroutine GRLJ02). C 4th character: R for a rectangular view surface or C S for a square view surface. C C A few notes are in order. First, not all of the possible combinations C above are supported (currently). The driver that goes by the name of C PHOT is a driver that puts out bitmaps suitable for inclusion in TeX C output if you are using the Arbortext DVIHP program. The only drivers C that will work with unexpanded LaserJet are LJ08 and LJ09. The other C seven drivers require a LaserJet Plus or LaserJet II. Finally, do NOT C attempt to send grayscale plots to the drivers that use the optimized C bitmap dumps. Terrible things will happen. C C If you add a driver to this file, please try to use the naming C convention outlined above and send me a copy of the revisions. I may C be reached at sca@iowa.physics.uiowa.edu on the Internet or IOWA::SCA C on SPAN. C----------------------------------------------------------------------- C This is the number of currently C installed devices. INTEGER*4 NDEV PARAMETER (NDEV = 9) C BYTE ESC, FF LOGICAL BITMAP(NDEV), INIT, PORTRAIT(NDEV), TEX INTEGER BUFFER, BX, BY, DEVICE, HC(NDEV), I, IC, IER INTEGER GRFMEM, GRGMEM, LUN, NPICT INTEGER VC(NDEV) REAL MAXX(NDEV), MAXY(NDEV), RESOL(NDEV), XBUF(4) REAL XMAX, YMAX CHARACTER ALTTYP(NDEV)*3, DEFNAM*12, MODE*20, MSG*10 CHARACTER TYPE(NDEV)*4 PARAMETER (ESC = 27) PARAMETER (FF = 12) PARAMETER (DEFNAM = 'pgplot.ljplt') SAVE DATA INIT /.TRUE./ C These are the NDEV sets of C device characteristics. DATA BITMAP /.FALSE., .FALSE., .FALSE., .TRUE., .TRUE., 1 .TRUE., .TRUE., .TRUE., .TRUE./ DATA PORTRAIT /.FALSE., .TRUE., .TRUE., .FALSE., .TRUE., 1 .FALSE., .TRUE., .TRUE., .TRUE./ DATA HC / 0, 0, 0, 1139, 878, 1 0, 0, 1300, 754/ DATA VC / 0, 0, 0, 1411, 1743, 1 0, 0, 2156, 1605/ DATA MAXX / 3149.0, 2399.0, 2399.0, 1962.0, 1695.0, 1 1574.0, 1199.0, 671.0, 599.0/ DATA MAXY / 2399.0, 3149.0, 3149.0, 1471.0, 1695.0, 1 1199.0, 1574.0, 671.0, 599.0/ DATA RESOL / 300.0, 300.0, 300.0, 300.0, 300.0, 1 150.0, 150.0, 150.0, 100.0/ C These are around only for C (pre)historical reasons. DATA ALTTYP / 'HPN', 'HPV', 'TEX', 'HPR', 'HPE', 1 'HPF', 'HPT', 'HPH', 'HPM'/ DATA TYPE / 'LHOR', 'PHOR', 'PHOT', 'LHBR', 'PHBS', 1 'LMBR', 'PMBR', 'PMBS', 'PLBS'/ C----------------------------------------------------------------------- C First time, translate logical C name PGPLOT_LJ_MODE and set C device accordingly. IF (INIT) THEN CALL GRGENV ('LJ_MODE', MODE, I) DO 1 I = 1, NDEV WRITE (MSG, '(A2, I2.2)') 'LJ', I IF (MODE(1:4) .EQ. TYPE(I) .OR. 1 MODE(1:3) .EQ. ALTTYP(I) .OR. 2 MODE(1:4) .EQ. MSG(1:4)) THEN DEVICE = I GOTO 2 END IF 1 CONTINUE C If no match, choose LHBR DEVICE = 4 2 INIT = .FALSE. C See if user has chosen the C TeX plotfile format. TEX = .FALSE. IF (DEVICE .EQ. 3) TEX = .TRUE. END IF C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in LaserJet device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE WRITE (MSG, '(I2.2)') DEVICE CHR = 'LJ' // MSG(1 : 2) // ' (' // TYPE(DEVICE) // ')' NBUF = 0 LCHR = 11 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 RBUF(2) = MAXX(DEVICE) RBUF(3) = 0.0 RBUF(4) = MAXY(DEVICE) RBUF(5) = 0.0 RBUF(6) = 1.0 NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE RBUF(1) = RESOL(DEVICE) RBUF(2) = RESOL(DEVICE) RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CONTINUE CHR = 'HNNNNNNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = DEFNAM NBUF = 0 LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 RBUF(2) = MAXX(DEVICE) RBUF(3) = 0.0 RBUF(4) = MAXY(DEVICE) NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE IF (RESOL(DEVICE) .EQ. 300.0) THEN RBUF(1) = 3.0 ELSE IF (RESOL(DEVICE) .EQ. 150.0) THEN RBUF(1) = 2.0 ELSE RBUF(1) = 1.0 END IF NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C Obtain a logical unit number. CALL GRGLUN (LUN) C Check for an error. IF (LUN .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit.') RBUF(2) = 0 RETURN ELSE RBUF(1) = LUN END IF C Open the output file. OPEN (UNIT = LUN, FILE = CHR(:LCHR), CARRIAGECONTROL = 'NONE', 1 DEFAULTFILE = DEFNAM, STATUS = 'NEW', 2 RECL = 128, FORM = 'UNFORMATTED', RECORDTYPE = 'VARIABLE', 3 IOSTAT = IER) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for LaserJet plot: ' // 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN (LUN) RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN, NAME = CHR) LCHR = LEN (CHR) 91 IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 91 END IF END IF C Initialize the plot file. IF (.NOT. TEX) THEN C Choose portrait orientation WRITE (LUN) ESC, '&l0O' C Set horizontal and vertical C spacing IF (BITMAP(DEVICE)) THEN WRITE (LUN) ESC, '&l6C' WRITE (LUN) ESC, '&k10H' ELSE WRITE (LUN) ESC, '&k.4H' WRITE (LUN) ESC, '&l.16C' END IF WRITE (LUN) ESC, '&l2E' END IF C Set the graphics resolution WRITE (MSG, '(I3)') INT (RESOL(DEVICE)) WRITE (LUN) ESC, '*t', MSG(1:3), 'R' C Initialize the page counter. NPICT = 0 RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE IF (BITMAP(DEVICE)) THEN WRITE (LUN) ESC, '&l8C' ELSE IF (.NOT. TEX) THEN WRITE (LUN) ESC, '&l6D' WRITE (LUN) ESC, '&k10H' WRITE (LUN) ESC, '&l2E' END IF C Close the file. CLOSE (LUN, STATUS = 'KEEP') C Deallocate the logical unit. CALL GRFLUN (LUN) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Set the bitmap size. XMAX = RBUF(1) YMAX = RBUF(2) C Calculate the dimensions of the C plot buffer. IF (PORTRAIT(DEVICE)) THEN BX = INT (XMAX) / 8 + 1 BY = INT (YMAX) + 1 ELSE BX = INT (YMAX) / 8 + 1 BY = INT (XMAX) + 1 END IF C Allocate a plot buffer. IER = GRGMEM (BX * BY, BUFFER) C Check for error and clean up C if one was found. IF (IER .NE. 1) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate a plot buffer.') END IF C Increment the page number. NPICT = NPICT + 1 C Eject the page from the printer. IF (NPICT .GT. 1) WRITE (LUN) FF C Set the cursor position and C start graphics mode. IF (BITMAP(DEVICE)) THEN WRITE (MSG(1:4), '(I4.4)') HC(DEVICE) WRITE (MSG(5:8), '(I4.4)') VC(DEVICE) WRITE (LUN) ESC, '&a', MSG(1:4), 'h', MSG(5:8), 'V' END IF C Zero out the plot buffer. CALL GRLJ04 (BX * BY, %VAL(BUFFER)) RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Apply any needed tranformation. IF (PORTRAIT(DEVICE)) THEN DO 125 I = 1, 4 XBUF(I) = RBUF(I) 125 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) XBUF(3) = RBUF(4) XBUF(4) = XMAX - RBUF(3) END IF C Draw the point into the bitmap. CALL GRLJ00 (1, XBUF, IC, BX, BY, %VAL (BUFFER)) RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Apply any needed tranformation. IF (PORTRAIT(DEVICE)) THEN DO 135 I = 1, 2 XBUF(I) = RBUF(I) 135 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) END IF C Draw the point into the bitmap. CALL GRLJ00 (0, XBUF, IC, BX, BY, %VAL(BUFFER)) RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Write out the bitmap. IF (BITMAP(DEVICE)) THEN CALL GRLJ01 (LUN, BX, BY, %VAL (BUFFER)) ELSE CALL GRLJ02 (LUN, BX, BY, %VAL (BUFFER), TEX) END IF C Deallocate the plot buffer. IER = GRFMEM (BX * BY, BUFFER) C Check for an error. IF (IER .NE. 1) THEN CALL GRGMSG (IER) CALL GRWARN ('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) C If out of range set to black. IF (IC .LT. 0 .OR. IC .GT. 1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C (Not implemented: should not be called.) C 190 CONTINUE GOTO 900 C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C (Not implemented: should not be called.) C 200 CONTINUE GOTO 900 C C--- IFUNC = 21, Set color representation. ----------------------------- C (Not implemented: ignored.) C 210 CONTINUE RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C (Not implemented: should not be called.) C 220 CONTINUE GOTO 900 C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C (Not implemented: should not be called.) C 240 CONTINUE GOTO 900 C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C*GRLJ00 -- PGPLOT Hewlett Packard LaserJet driver, draw line C+ SUBROUTINE GRLJ00 (LINE, RBUF, ICOL, BX, BY, BITMAP) INTEGER BX, BY, ICOL, LINE BYTE BITMAP(BX, BY) REAL RBUF(4) C C Draw a straight line segment from absolute pixel coordinates (RBUF(1), C RBUF(2)) to (RBUF(3), RBUF(4)). The line either overwrites (sets to C black) or erases (sets to white) the previous contents of the bitmap, C depending on the current color index. Setting bits is accomplished C with a VMS BISB2 instruction, expressed in Fortran as .OR.; clearing C bits is accomplished with a VMS BICB2 instruction, expressed in C Fortran as .AND. .NOT.. The line is generated with a Simple Digital C Differential Analyser (ref: Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R Ending point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0 : 7) INTEGER K, KX, KY, LENGTH REAL D, XINC, XP, YINC, YP DATA QMASK /'80'X, '40'X, '20'X, '10'X, 1 '08'X, '04'X, '02'X, '01'X/ C----------------------------------------------------------------------- IF (LINE .GT. 0) THEN D = MAX (ABS (RBUF(3) - RBUF(1)), ABS (RBUF(4) - RBUF(2))) LENGTH = D IF (LENGTH .EQ. 0) THEN XINC = 0.0 YINC = 0.0 ELSE XINC = (RBUF(3) - RBUF(1)) / D YINC = (RBUF(4) - RBUF(2)) / D END IF ELSE LENGTH = 0 XINC = 0.0 YINC = 0.0 END IF XP = RBUF(1) + 0.5 YP = RBUF(2) + 0.5 IF (ICOL .NE. 0) THEN DO K = 0, LENGTH KX = XP KY = (BY - 1) - INT (YP) BITMAP(KX / 8 + 1, KY + 1) = BITMAP(KX / 8 + 1, KY + 1) .OR. 1 QMASK(MOD (KX, 8)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K = 0,LENGTH KX = XP KY = (BY - 1) - INT (YP) BITMAP(KX / 8 + 1, KY + 1) = BITMAP(KX / 8 + 1, KY + 1) 1 .AND. (.NOT. QMASK(MOD (KX, 8))) XP = XP + XINC YP = YP + YINC END DO END IF C----------------------------------------------------------------------- RETURN END C*GRLJ01 -- PGPLOT LaserJet driver, copy bitmap to output file C+ SUBROUTINE GRLJ01 (LUN, BX, BY, BITMAP) INTEGER BX, BY, LUN BYTE BITMAP(BX, BY) C C Arguments: C C LUN (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE ESC INTEGER I, J, K CHARACTER KSTR*3 PARAMETER (ESC = 27) C----------------------------------------------------------------------- C Start graphics mode WRITE (LUN) ESC, '*r1A' C Loop through bitmap DO J = 1, BY C Search for last non-NUL DO K = BX, 2, -1 IF (BITMAP(K, J) .NE. '00'X) GO TO 10 END DO C Guarantee that we know what K C is after loop. C (Remember FORTRAN IV!?) K = 1 C Encode length of line 10 WRITE (KSTR, '(I3.3)') K C Write out the raster line WRITE (LUN) ESC, '*b', KSTR, 'W', (BITMAP(I, J), I = 1, K) END DO C Turn off graphics mode. WRITE (LUN) ESC, '*rB' C----------------------------------------------------------------------- RETURN END C*GRLJ02 -- PGPLOT LaserJet+ driver, dump bitmap to device C+ SUBROUTINE GRLJ02 (LUN, BX, BY, BITMAP, TEX) LOGICAL TEX INTEGER LUN, BX, BY BYTE BITMAP(BX, BY) C C Output raster for this page. This routine has been optimised to C minimize the memory usage in the LaserJet. This sometimes leads to a C larger file than if a straight bitmap approach had been used. C C NOTE: This subroutine is a kludge to make a 512K LaserJet produce C full page plots at 300dpi. It will not always produce the plot C on one page. If you overrun the memory restrictions, two pages C will be printed, each containing parts of the plot. One must C then resort to cut and paste techniques to restore the plot. C Most simple line graphs do not come close to the memory limit, C but sometimes a messy contour plot will. DON'T EVEN THINK C ABOUT SENDING A GREYSCALE TO THIS SUBROUTINE! C C Arguments: C C LUN I I Logical unit number of output file C BX, BY I I Dimensions of frame buffer C BITMAP I/O B (address of) the frame buffer. C C Version 1.0 03-Sep-1986 S. C. Allendorf C Version 2.0 08-Dec-1986 S. C. Allendorf Use relative positioning C Version 2.1 28-Dec-1986 S. C. Allendorf Optimize positioning code C Version 3.0 02-Jan-1987 S. C. Allendorf Add code for rules C VERSION 3.1 10-FEB-1988 S. C. Allendorf Attempt to speed up code C----------------------------------------------------------------------- BYTE ESC, N0 LOGICAL NOBIT INTEGER CNUM, CONUM, CURCOL, CURROW, FB(35), FB2(25), I, IPOS INTEGER IYOFF, J, K, L, M, N, NB(35), NBNUM, NBTOT, NBNUM2 INTEGER NB2(25), RNUM, RONUM, GRLJ03 CHARACTER ALLONE*300, COL*5, NBYTE*4, NULLS*(10), ROW*5, X*300 PARAMETER (N0 = 0) PARAMETER (ESC = 27) C----------------------------------------------------------------------- C Define some useful constants IF (TEX) THEN IYOFF = 0 ELSE IYOFF = 75 END IF DO J = 1, 10 NULLS(J:J) = CHAR (0) END DO DO J = 1, 300 ALLONE(J:J) = CHAR (255) END DO C Initialize some variables CURCOL = 0 CURROW = 0 C Position the cursor IF (.NOT. TEX) THEN WRITE (LUN) ESC, '*p0y0X' END IF C Set up vertical rule height WRITE (LUN) ESC, '*c1B' C Write out each line on page DO K = 1, BY C Copy raster to buffer and find C the beginning and end of the C bitmap line NOBIT = .TRUE. NBTOT = 0 FB(1) = BX DO J = 1, BX X(J:J) = CHAR (BITMAP(J,K)) IF (X(J:J) .NE. NULLS(1:1)) THEN NOBIT = .FALSE. NBTOT = J FB(1) = MIN (FB(1), J) END IF END DO C Break line into pieces IF (.NOT. NOBIT) THEN L = 1 GO TO 20 10 NB(L) = FB(L) + IPOS - 2 L = L + 1 C Search for first non-null DO J = NB(L-1) + 11, NBTOT IF (X(J:J) .NE. NULLS(1:1)) THEN FB(L) = J GO TO 20 END IF END DO C Search for a string of nulls 20 IPOS = INDEX (X(FB(L):NBTOT), NULLS) IF (IPOS .EQ. 0) THEN NB(L) = NBTOT GO TO 30 ELSE GO TO 10 END IF C Loop through each substring 30 DO J = 1, L C Search for rules M = 1 FB2(1) = FB(J) GO TO 50 40 IF (IPOS .NE. 1) THEN NB2(M) = 0 DO I = FB2(M), FB2(M) + IPOS - 2 IF (X(I:I) .NE. NULLS(1:1)) THEN NB2(M) = MAX (FB2(M), I) END IF END DO M = M + 1 FB2(M) = FB2(M-1) + IPOS - 1 IF (NB2(M-1) .EQ. 0) THEN FB2(M-1) = FB2(M) M = M - 1 END IF END IF C Search for first non- DO N = FB2(M) + 25, NB(J) IF (X(N:N) .NE. ALLONE(1:1)) THEN NB2(M) = N - 1 M = M + 1 FB2(M) = N GO TO 50 END IF END DO NB2(M) = NB(J) GO TO 60 C Search for a string of s 50 IPOS = INDEX (X(FB2(M):NB(J)), ALLONE(1:25)) IF (IPOS .EQ. 0) THEN NB2(M) = NB(J) GO TO 60 ELSE GO TO 40 END IF C Print each of the substrings 60 DO I = 1, M C Get the number of bytes NBNUM = NB2(I) - FB2(I) + 1 C ENCODE (4, 1000, NBYTE) NBNUM WRITE (NBYTE, 1000) NBNUM NBNUM2 = GRLJ03 (NBNUM) C Calculate the row and column RONUM = K + IYOFF CONUM = (FB2(I) - 1) * 8 C Determine the positioning C sequence and write it out IF (RONUM .NE. CURROW .AND. CONUM .NE. CURCOL) THEN RNUM = RONUM - CURROW CNUM = CONUM - CURCOL C ENCODE (5, 1010, ROW) RNUM C ENCODE (5, 1010, COL) CNUM WRITE (ROW, 1010) RNUM WRITE (COL, 1010) CNUM RNUM = GRLJ03 (ABS (RNUM)) + 1 CNUM = GRLJ03 (ABS (CNUM)) + 1 WRITE (LUN) ESC, '*p', ROW(6-RNUM:5), 'y', + COL(6-CNUM:5), 'X' ELSE IF (RONUM .NE. CURROW) THEN RNUM = RONUM - CURROW C ENCODE (5, 1010, ROW) RNUM WRITE (ROW, 1010) RNUM RNUM = GRLJ03 (ABS (RNUM)) + 1 WRITE (LUN) ESC, '*p', ROW(6-RNUM:5), 'Y' ELSE IF (CONUM .NE. CURCOL) THEN CNUM = CONUM - CURCOL C ENCODE (5, 1010, COL) CNUM WRITE (COL, 1010) CNUM CNUM = GRLJ03 (ABS (CNUM)) + 1 WRITE (LUN) ESC, '*p', COL(6-CNUM:5), 'X' END IF C Check for all bits set in C substring IF ((INDEX (X(FB2(I):NB2(I)), ALLONE(1:NBNUM)) .EQ. 1) + .AND. NBNUM .GE. 5) THEN NBNUM = NBNUM * 8 C ENCODE (4, 1000, NBYTE) NBNUM WRITE (NBYTE, 1000) NBNUM NBNUM2 = GRLJ03 (NBNUM) WRITE (LUN) ESC, '*c', NBYTE(5-NBNUM2:4), 'A' WRITE (LUN) ESC, '*c0P' CURROW = RONUM CURCOL = CONUM ELSE C Write out raster line WRITE (LUN) ESC, '*r1A' WRITE (LUN) ESC, '*b', NBYTE(5-NBNUM2:4), 'W', + X(FB2(I):NB2(I)) WRITE (LUN) ESC, '*rB' CURROW = RONUM + 1 CURCOL = CONUM END IF END DO END DO END IF END DO C----------------------------------------------------------------------- 1000 FORMAT (I4.4) 1010 FORMAT (SP,I5) RETURN END C*GRLJ03 -- PGPLOT LaserJet+ driver, calculate length of an integer C+ INTEGER FUNCTION GRLJ03 (I) INTEGER I C C This function calculates the number of digits in a supplied integer. C C Arguments: C C I I I Integer value of number C GRLJ03 O I Length of printed representation of I C C Version 1.0 10-Feb-1988 S. C. Allendorf C----------------------------------------------------------------------- IF (I .GE. 10) THEN IF (I .GE. 100) THEN IF (I .GE. 1000) THEN GRLJ03 = 4 ELSE GRLJ03 = 3 END IF ELSE GRLJ03 = 2 END IF ELSE GRLJ03 = 1 END IF C----------------------------------------------------------------------- RETURN END C*GRLJ04 -- zero fill buffer C+ SUBROUTINE GRLJ04 (BUFSIZ,BUFFER) C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL /0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END 0 END DO C Guarantee that we know what K C is after loop. C (Remember FORTRAN IV!?) K = 1 C Encode length of line 10 WRITE (KSTR, '(I3.3)') K C Write out the raster line WRITE (LUN) ESC, '*b', KSTR, 'W', (BITMAP(I, J), I =pgplot/drivers/lndriv.f010064400040640000322000000357760641627036000157030ustar00tjpcitmbr00000400000017C*LNDRIV PGPLOT DRIVER FOR DIGITAL LN03 (LANDSCAPE) SUBROUTINE LNDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Digital LN03 Laser Printer (landscape) C File : LNDRIVER.FOR C----------------------------------------------------------------------- C Version 1.0 - 1989 Nov. Sid Penstone, Queen's University C Last Revision Dec.1,1989, added direct code for vertical lines, C now do dots as a case of a zero length vector C----------------------------------------------------------------------- C This routine has been written specifically for the LN03-PLUS C Laser Printer C C Name: '/LN03' C In all case, the initialization sequences are written out, C whether or not the plotter is connected as a terminal, C or driven from an intermediate file. C C If there is more than one plot C the page is ejected before the next one C C ref: Digital LN03 Programmer Reference Manual, P/N EK-OLN03-002, C and Digital LN03-Plus " " " P/N EK-LN03S-001 C C We end up with a 9" by 7" display area. C C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='LN03 (Digital LN03 Laser Printer, landscape)') C INTEGER MARGIN, NXPIX, NYPIX, NSIXROWS, NSIXCOLS PARAMETER(MARGIN=150) PARAMETER(NXPIX=3000) PARAMETER(NYPIX=2400) PARAMETER(NSIXROWS=(NYPIX/6)+2) PARAMETER(NSIXCOLS=NXPIX) CHARACTER*10 MSG INTEGER WIDTH,XLEFT,XRIGHT,YBOT,YTOP, INTENS, XMAX, YMAX, XMIN INTEGER UNIT, IER INTEGER I0, J0, I1, J1 INTEGER IK1, IK2, IK3, IK4, IK5, PLOTNO CHARACTER*1 ESC DATA XLEFT,XRIGHT,YTOP,YBOT/0,NXPIX,0,NYPIX/ DATA ESC /27/ DATA WIDTH /2/ LOGICAL ACTIVE(0:NSIXROWS) C Data for the allocation routines INTEGER GRGMEM, GRFMEM INTEGER BUFLEN, IPOINTS, IERR LOGICAL ALLOC SAVE BUFLEN, IPOINTS, ALLOC DATA ALLOC /.FALSE./ DATA IPOINTS /-1/ C for debugging LOGICAL DEBUG DATA DEBUG/.FALSE./ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = NXPIX - 2*MARGIN RBUF(3) = 0 RBUF(4) = NYPIX - 2*MARGIN RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 300.0 RBUF(2) = 300.0 RBUF(3) = WIDTH NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C No thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = 'PGPLOT.LN3' LCHR = 11 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = NXPIX-2*MARGIN RBUF(3) = 0 RBUF(4) = NYPIX-2*MARGIN NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 10 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C Try to open the graphics device CALL GRGLUN(UNIT) OPEN (UNIT=UNIT,FILE=CHR(:LCHR),STATUS='NEW', 1 FORM='FORMATTED', CARRIAGECONTROL='LIST', 1 RECL=512,IOSTAT=IER) IF (IER.NE.0) THEN CALL ERRSNS(IK1,IK2,IK3,IK4,IK5) CALL GRWARN('Cannot open graphics device ' 1 //CHR(1:LCHR)) IF (IK2.NE.0 .AND. IK2.NE.1) CALL GRGMSG(IK2) IF (IK5.NE.0 .AND. IK5.NE.1) CALL GRGMSG(IK5) RBUF(2) = 0 RETURN ENDIF RBUF(1) = UNIT RBUF(2) = 1 NBUF = 2 C Now allocate the bitmap buffers (Assume integer*2) IF (.NOT. ALLOC) THEN BUFLEN = NSIXROWS * NSIXCOLS IERR = GRGMEM(2*BUFLEN, IPOINTS) IF (IERR .NE. 1 ) THEN CALL GRGMSG(IERR) CALL GRWARN('Memory allocation failure') RETURN ENDIF ALLOC = .TRUE. ENDIF C Digital says that the allocated memory may not be zeroed: C Clear the row flags (and the bit map) CALL LN03_CLEAR(%VAL(IPOINTS),BUFLEN,ACTIVE,NSIXROWS) C C always write the preamble C this resets the plotter WRITE (UNIT, '(A)') ESC//'c' C this sets it for landscape, origin at corner WRITE (UNIT, '(A)') ESC//'[?21 J' PLOTNO = 0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CONTINUE C always turn it off CLOSE (UNIT) CALL GRFLUN(UNIT) C Deallocate the buffer IF (ALLOC .OR. IPOINTS .GE. 0) THEN IERR = GRFMEM(2*BUFLEN, IPOINTS) IF (IERR .NE. 1 ) THEN CALL GRGMSG(IERR) CALL GRWARN('Deallocation failure') RETURN ENDIF ALLOC = .FALSE. IPOINTS = -1 ENDIF RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C WE COULD GET THE VALUE OF XMAX AND YMAX HERE YMAX = YBOT - 2*MARGIN XMIN = XLEFT + MARGIN XMAX = XRIGHT - MARGIN PLOTNO = PLOTNO + 1 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = XMIN + NINT(RBUF(1)) J0 = YMAX - NINT(RBUF(2)) I1 = XMIN + NINT(RBUF(3)) J1 = YMAX - NINT(RBUF(4)) CALL LN03_VECTOR(I0,J0,I1,J1,WIDTH,XLEFT,XRIGHT, 1 YTOP,YBOT,%val(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS,INTENS) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I0 = XMIN + NINT(RBUF(1)) J0 = YMAX - NINT(RBUF(2)) CALL LN03_VECTOR(I0,J0,I0,J0,WIDTH,XLEFT,XRIGHT, 1 YTOP,YBOT,%VAL(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS,INTENS) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE CALL LN03_DUMP(UNIT,XLEFT,XMAX+WIDTH,YTOP+MARGIN,YMAX+WIDTH, 1%val(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS) C Clear the bitmap buffer IF (ALLOC) THEN CALL LN03_CLEAR(%val(IPOINTS),BUFLEN,ACTIVE,NSIXROWS) ENDIF C Eject the paper with a form feed C WRITE (UNIT, '(A)') CHAR(12) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 INTENS = NINT(RBUF(1)) IF (INTENS .GT.1) INTENS = 1 if (debug) write(0,'(A,G13.7,I6)')'Intens= ',RBUF(1),INTENS RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Null operation: buffering is not implemented.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 RETURN C Other colors are not implemented C C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE WRITE (UNIT, '(A)') CHR(:LCHR) RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in LN03 device driver: '//MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END C------------------- PRIMITIVE LN03 FUNCTIONS ------------------- C C---------------------------------------------------------------- C CLEAR THE BITMAP IF IT WAS USED BEFORE C SUBROUTINE LN03_CLEAR(BUFF,N,BUSY,NR) INTEGER*2 BUFF(0:*) LOGICAL BUSY(0:*) INTEGER N, I , NR DO 1 I = 0, N-1 1 BUFF(I) = 0 DO 2 I = 0, NR-1 2 BUSY(I) = .FALSE. RETURN END C--------------------------------------------------------------------- CHARACTER*10 FUNCTION LN03_PACK(IARG,IP) C----------------------------------------------------------------------- C (Internal routine, LN): Identical to the grgl00() routine C This subroutine translates the argument IARG into a character C string and then returns the position of the first non-blank C character in the string C Arguments: IARG C IP (returned) C----------------------------------------------------------------------- INTEGER IARG, IP C LN03_PACK = ' ' IP = 10 WRITE(LN03_PACK,'(I10)') IARG DO IP=1,10 IF (LN03_PACK(IP:IP) .NE. ' ') RETURN ENDDO END C---------------------------- VECTOR DRAWING -------------------------- SUBROUTINE LN03_VECTOR(X1,Y1,X2,Y2,WIDTH,XLEFT,XRIGHT, 1 YTOP,YBOT,POINTS,ACTIVE,NSIXROWS,NSIXCOLS,INTENS) C---------------------------------------------------------------------- C C Based on Bresenham's algorithm, and a C version written by C Paul Demone, Canadian Microelectronics Corporation C C We enter with the values x,y converted to internal values C That is, we have reflected the direction of Y C INTEGER X1,Y1,X2,Y2,WIDTH,XLEFT,XRIGHT,YBOT,YTOP,NSIXCOLS, 1 NSIXROWS, INTENS INTEGER X, Y, DX, DY, ADX, ADY, E, DA, DB, D1X, D1Y, D2X, D2Y INTEGER XX, YY, INDX, ITEMP INTEGER*2 SHIFT INTEGER*2 POINTS(0:*) LOGICAL ACTIVE(0:*) logical debug data debug /.false./ C if (debug) write(0,'(A,I6,I6)')'INTENS= ',INTENS C Start at X1, Y1 if(debug)write(0, '(A,4(I6),A,I3,A,2(I10))')'LINE: ', 1x1,y1,x2,y2,'INTENS=',INTENS,' ROW,COL: ', 1 (Y1/6),((Y1/6)*NSIXCOLS+X1) C Note that we always try to move the X index inside the loops, since they C are adjacent in the bitmap array C If this is a horizontal line, then we can do it faster IF (Y2 .EQ. Y1) THEN IF(X2 .LT. X1) THEN ITEMP = X1 X1 = X2 X2 = ITEMP ENDIF YY = Y1 DO WHILE (YY .LT. Y1 + WIDTH .AND. YY .LT. YBOT) INDX = (YY/6)*NSIXCOLS SHIFT = JMOD(YY, 6) XX = X1 DO WHILE ( XX .LT. X2 + WIDTH .AND. XX .LT. XRIGHT) IF (INTENS .EQ. 0) THEN POINTS(INDX + XX) = IIBCLR(POINTS(INDX +XX), SHIFT) ELSE POINTS(INDX + XX) = IIBSET(POINTS(INDX +XX), SHIFT) ENDIF XX = XX + 1 ENDDO IF (INTENS .NE. 0) ACTIVE(YY/6) = .TRUE. YY = YY + 1 ENDDO RETURN C Might be a vertical line: ELSEIF (X2. EQ. X1) THEN IF (Y2 .LT. Y1) THEN ITEMP = Y1 Y1 = Y2 Y2 = ITEMP ENDIF YY = Y1 DO WHILE (YY .LT. Y2 + WIDTH .AND. YY .LT. YBOT) INDX = (YY/6)*NSIXCOLS SHIFT = JMOD(YY, 6) XX = X1 DO WHILE ( XX .LT. X1 + WIDTH .AND. XX .LT. XRIGHT) IF (INTENS .EQ. 0) THEN POINTS(INDX + XX) = IIBCLR(POINTS(INDX +XX), SHIFT) ELSE POINTS(INDX + XX) = IIBSET(POINTS(INDX +XX), SHIFT) ENDIF XX = XX + 1 ENDDO IF (INTENS .NE. 0) ACTIVE(YY/6) = .TRUE. YY = YY + 1 ENDDO RETURN ENDIF C It is a vector : Use the algorithm DX = X2 - X1 DY = Y2 - Y1 D2X = ISIGN(1,DX) D2Y = ISIGN(1,DY) ADX = IABS(DX) ADY = IABS(DY) C Check for the maximum number of steps: X or Y ? IF (ADX .GT. ADY) THEN DA = ADX DB = ADY D1Y = 0 D1X = ISIGN(1,DX) ELSE DA = ADY DB = ADX D1X = 0 D1Y = ISIGN(1,DY) ENDIF DB = 2*DB E = DB - DA DA = 2*DA X = X1 Y = Y1 C Here we will be using some VAX Fortran extensions ....... 800 CONTINUE C DO WHILE (.TRUE.) IF (X .GE. XLEFT .AND. Y .GE. YTOP .AND. 1 X .LT. XRIGHT .AND. Y .LT. YBOT) THEN C Don't come in here if we are already off scale ! C If it is ok, then add a cluster of pixels of size width by width C if(debug)write(0, '(4(I6))')x,y XX = X DO WHILE (XX .LT. X+WIDTH .AND. XX .LT. XRIGHT) YY = Y DO WHILE(YY .LT. Y+WIDTH .AND. YY .LT. YBOT) INDX = (YY/6)*NSIXCOLS + XX SHIFT = JMOD(YY,6) C IF(DEBUG)WRITE(UNIT,'(2(I6),I10,6(I6))') C 1 XX,YY,INDX,POINTS(INDX),INTENS,SHIFT IF (INTENS .EQ. 0) THEN POINTS(INDX) = IIBCLR(POINTS(INDX),SHIFT) ELSE POINTS(INDX) = IIBSET(POINTS(INDX),SHIFT) ACTIVE(YY/6) = .TRUE. ENDIF YY = YY + 1 ENDDO XX = XX +1 ENDDO ENDIF C Are we finished ? IF (X .EQ. X2 .AND. Y .EQ. Y2) RETURN C Else move to the next point IF ( E .GT. 0) THEN X = X + D2X Y = Y + D2Y E = E + DB - DA ELSE X = X + D1X Y = Y + D1Y E = E + DB ENDIF GOTO 800 C ENDDO END C ------------------------------------------------------------ SUBROUTINE LN03_DUMP(UNIT,XLEFT,XRIGHT,YTOP,YBOT, 1 POINTS,ACTIVE,NSIXROWS,NSIXCOLS) C------------------------------------------------------------- C Dump the bitmap to the printer C Only write active sixel rows, and do run length encoding, too C C C Parameters: C XLEFT: starting column in map, and initial x position C XRIGHT: last active column in map C YTOP: starting row in map, and initial y position C YBOT: last active row in the map INTEGER XLEFT, XRIGHT, YTOP, YBOT, NSIXROWS, NSIXCOLS, UNIT LOGICAL ACTIVE(0:*) INTEGER*2 POINTS(0:*) INTEGER*2 SXL INTEGER IROW, JCOL, K, PTR, RPT, INDX, N, MAXLEN CHARACTER*10 RUN, LN03_PACK CHARACTER*256 BUFFER CHARACTER*1 PAT, ESC DATA ESC /27/ DATA MAXLEN /75/ LOGICAL DEBUG DATA DEBUG /.false./ INTEGER IOFFSET PARAMETER(IOFFSET = 34) CHARACTER*10 NEWX,NEWY INTEGER N1,N2 NEWX = LN03_PACK(XLEFT,N1) NEWY = LN03_PACK(YTOP+IOFFSET,N2) C Start at the top of the paper, down one line plus offset C The pixels start 70 decipoints above the first line C Set up the sixel modes WRITE(UNIT, '(A)') ESC//'[7 I'//ESC//'[11h' WRITE (UNIT, '(A)') 1 ESC//'['//NEWX(N1:)//'`'//ESC//'['//NEWY(N2:)//'d' 1//ESC//'P0;0;1q"100;100' C Now scan the bitmap PTR = 1 DO 1000 IROW = 0, NSIXROWS-2 IF (ACTIVE(IROW)) THEN if(debug)write(0,'(a,4(i6))')'row = ',irow JCOL = XLEFT DO WHILE (JCOL .LT. XRIGHT) INDX = IROW*NSIXCOLS SXL = POINTS(INDX + JCOL) PAT = CHAR(IIAND(SXL,63) + 63) RPT = 0 C Look for repeated values on the rest of the line K = JCOL + 1 DO WHILE( K .LT. XRIGHT .AND. 1 SXL .EQ. POINTS(INDX + K)) RPT = RPT +1 K = K + 1 ENDDO C IF (DEBUG) WRITE(1, '(2I10,2I6,1X,A,I5,I5)') C 1 indx,indx+jcol, IROW, JCOL, PAT,ICHAR(PAT),SXL C Now check if there were any repeats IF (RPT .GT. 0) THEN RUN = LN03_PACK(RPT +1, N) BUFFER(PTR:) = '!'//RUN(N:)//PAT PTR = PTR + LEN(RUN(N:)) + 2 JCOL = JCOL + RPT + 1 ELSE BUFFER(PTR:PTR) = PAT PTR = PTR + 1 JCOL = JCOL + 1 ENDIF IF (PTR .GE. MAXLEN) THEN WRITE (UNIT, '(A)') BUFFER(:PTR-1) PTR = 1 ENDIF ENDDO ENDIF C Terminate each scan with a graphic newline character BUFFER(PTR:PTR) = '-' IF (PTR .GE. MAXLEN) THEN WRITE (UNIT, '(A)') BUFFER(:PTR) PTR = 1 ELSE PTR = PTR + 1 ENDIF 1000 CONTINUE IF(PTR .GT. 1) WRITE (UNIT, '(A)') BUFFER(:PTR-1) WRITE(UNIT, '(A)') ESC//CHAR(92) RETURN END NCpgplot/drivers/lsdriv.f010064400040640000322000000273550566772470100157140ustar00tjpcitmbr00000400000017C*LSDRIV -- PGPLOT driver for Canon LaserShot SUBROUTINE LSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Canon LaserShot printer (LIPS2/2+). C C Supported device: Canon LaserShot (LIPS2/2+). C Conforms to ISO646,2022,2375 and 6429 specifications. C VDM (graphics) conforms to proposed American National C Standard VDM mode. C C Device type code: /LIPS2 (landscape, mode 1) C /VLIPS2 (portrait, mode 2). C C Default file name: PGPLOT.LPS C C Default view surface dimensions: C 23 cm by 18 cm (landcsape) C 18 cm by 23 cm (portrait) C C Resolution: 240 pixels per inch in both directions. C C Color capability: Color indices 0 (erase) and 1 (black) are C supported. Note, hardware polygon fill is used and colors C 0-11 control the fill pattern. C C Input capability: None. C C File format: Variable length text records. C C Obtaining hardcopy: use lpr (unix) or print (dos) command. C C 17-Aug-1994 - [M.Hamabe] modified from cadriver.f C 18-Aug-1994 - [T.Pearson] merge landscape and portrait drivers C----------------------------------------------------------------------- CHARACTER*(*) DEFNAM PARAMETER (DEFNAM='PGPLOT.LPS') INTEGER IS2, IVESC PARAMETER (IS2=30, IVESC=125) C- The maximum physical size of the plot in units of 0.1 mm. INTEGER MXLEN, MXWID PARAMETER (MXLEN=2870, MXWID=1900) C- Default size of plot. INTEGER IDEFL, IDEFW PARAMETER (IDEFL=2300, IDEFW=1800) C CHARACTER CBUF*256 CHARACTER MSG*10 CHARACTER CDASH(5),CFILL(0:11) INTEGER GROPTX INTEGER I0, J0, I1, J1, IER INTEGER LUN, ICOL, NPTS, LBUF, LASX, LASY SAVE LUN, ICOL, NPTS, LBUF, LASX, LASY C--- C- Patterns defined with 2 and " appear the same on our Canon C- so only one is used. Pattern 0 causes the polygon not to C- be filled. Pattern ) erases interior of polygon is the C- last character in list as all colors > max are set to C- this pattern. DATA CFILL/')','1','(','''','&','%', : '$','2','#','!','0',')'/ DATA CDASH/'0','1','3','"','4'/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, : 110,120,130,140,150,160,900,180,190,200, : 210) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in LS device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 IF (MODE.EQ.1) THEN CHR='LIPS2 (Canon LIPS2 file, landscape orientation)' ELSE CHR='VLIPS2 (Canon LIPS2 file, portrait orientation)' END IF LCHR=48 RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 IF (MODE.EQ.1) THEN RBUF(2)=MXLEN RBUF(4)=MXWID ELSE RBUF(2)=MXWID RBUF(4)=MXLEN END IF RBUF(1)=0 RBUF(3)=0 RBUF(5)=0 RBUF(6)=11 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=254.0 RBUF(2)=254.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- 40 CHR='HNNANNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR=DEFNAM LCHR=LEN(DEFNAM) RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 IF (MODE.EQ.1) THEN RBUF(2)=IDEFL RBUF(4)=IDEFW ELSE RBUF(2)=IDEFW RBUF(4)=IDEFL ENDIF RBUF(1)=0 RBUF(3)=0 NBUF=4 RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 CALL GRGLUN (LUN) IER = GROPTX(LUN, CHR(1:LCHR), DEFNAM, 1) IF (IER.EQ.0) THEN RBUF(2)=1 ELSE CALL GRWARN('Cannot open output file for LPS plot') RBUF(2) = 0 CALL GRFLUN(LUN) ENDIF RBUF(1)=LUN RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN (LUN) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 CALL GRLS03(LUN,1,MODE) C- Use the origin transfer command to ensure that the picture is C- centered on the page. IF (MODE.EQ.1) THEN I0=(MXLEN-NINT(RBUF(1)))/2 J0=(MXWID-NINT(RBUF(2)))/2 ELSE I0=(MXWID-NINT(RBUF(1)))/2 J0=(MXLEN-NINT(RBUF(2)))/2 END IF CBUF(1:2)=CHAR(IVESC)//'"' LBUF=2 CALL GRLS04(J0,CBUF,LBUF) CALL GRLS04(I0,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRLS01(LUN,I0,J0,I1,J1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRLS01(LUN,I0,J0,I0,J0) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 CALL GRLS03(LUN,2,MODE) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C- Save pen number (up to 11) for possible use in pattern interior. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),11)) RBUF(1)=MAX(0,MIN(ICOL,1)) IF(ICOL.EQ.0) THEN CBUF(1:4)=CHAR(IVESC)//'G2'//CHAR(IS2) ELSE CBUF(1:4)=CHAR(IVESC)//'G0'//CHAR(IS2) END IF WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C- Currently turned off, since pattern is reset at beginning of C- every new line segment. Note, if GRLS01 was modified to C- properly use polylines then dash pattern may work better. 190 CBUF(1:4)='E1'//CDASH(NINT(RBUF(1)))//CHAR(IS2) WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- 200 IF(NPTS.EQ.0) THEN NPTS=RBUF(1) CBUF(1:5)='I'//CFILL(ICOL)//'0'//CHAR(IS2)//'2' LBUF=5 LASX=0 LASY=0 ELSE NPTS=NPTS-1 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRLS04(J0-LASY,CBUF,LBUF) CALL GRLS04(I0-LASX,CBUF,LBUF) LASX=I0 LASY=J0 IF(NPTS.EQ.0) THEN LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) 11 FORMAT(A) LBUF=0 END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C- (not possible but can be called). 210 RETURN C----------------------------------------------------------------------- END C*GRLS01 -- PGPLOT driver for Canon LaserShot, line segment SUBROUTINE GRLS01 (LUN,I0,J0,I1,J1) C----------------------------------------------------------------------- C Canon device driver support routine. Draws a line segment. C Current routine plots end line segment as a separate polyline. C This can be improved. C C I0,J0 I I The coordinate of the start point. C I1,J1 I I The coordinate of the end point. C C 26-JUN-86 - [AFT] C----------------------------------------------------------------------- INTEGER IS2 PARAMETER (IS2=30) INTEGER LUN, I0, J0, I1, J1 INTEGER LBUF, IX, IY CHARACTER CBUF*64 C--- CBUF(1:1)='1' LBUF=1 CALL GRLS04(J0,CBUF,LBUF) CALL GRLS04(I0,CBUF,LBUF) IX=I1-I0 IY=J1-J0 CALL GRLS04(IY,CBUF,LBUF) CALL GRLS04(IX,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(1:LBUF) 11 FORMAT(A) RETURN END C*GRLS03 -- PGPLOT driver for Canon LaserShot, begin/end picture SUBROUTINE GRLS03(LUN,ICMD,MODE) C----------------------------------------------------------------------- C Canon LIPS2 device driver support routine. Outputs to LUN the string C that begins a new picture (ICMD=1) or ends the current picture (ICMD=2). C C- LUN I I Logical unit of output file. C- ICMD I I =1 to begin plot, =2 to terminate plot. C- MODE I I =1 for landcsape, =2 for portrait. C C 19-Aug-1994 - [M.Hamabe, Inst.of Astron., U.Tokyo, Japan] C Modified version of grca03.f (for LIPS2 command) C----------------------------------------------------------------------- INTEGER IESC, IS2 PARAMETER (IESC=27, IS2=30) INTEGER LUN,ICMD,MODE CHARACTER CBUF*35 C--- IF(ICMD.EQ.1) THEN C - Go to ISO mode (ignored if in ISO mode already), Hard reset, C - and then go to ISO again (in case dip switches set to Diablo). CBUF( 1: 4)=CHAR(IESC)//';'//CHAR(IESC)//'c' CBUF( 5: 6)=CHAR(IESC)//';' C - Define paper orientation IF (MODE.EQ.1) THEN CBUF( 7:11)=CHAR(IESC)//CHAR(91)//'14p' ELSE CBUF( 7:11)=CHAR(IESC)//CHAR(91)//'15p' END IF C - Enable full paint mode. CBUF(12:16)=CHAR(IESC)//CHAR(91)//'2&z' C - Go to vector mode. CBUF(17:20)=CHAR(IESC)//CHAR(91)//'&'//CHAR(125) C - Begin picture CBUF(21:28)='#PGPLOT'//CHAR(IS2) C - Scaling mode 1 pixel, Begin picture body. CBUF(29:35)='!0#1'//CHAR(IS2)//'$'//CHAR(IS2) WRITE(LUN,'(A)') CBUF(1:35) ELSE IF(ICMD.EQ.2) THEN C - End picture, Return to text (0,0) CBUF(1:7)='%'//CHAR(IS2)//CHAR(125)//'p00'//CHAR(IS2) WRITE(LUN,'(A)') CBUF(1: 7) END IF RETURN END C*GRLS04 -- PGPLOT driver for Canon LaserShot, convert integer SUBROUTINE GRLS04(NUM,CBUF,LBUF) C----------------------------------------------------------------------- C Canon device driver support routine. Converts an integer into C the form used by the Canon Laser printer. C C- NUM I I Integer to be converted. C- CBUF I/O C* Buffer string C- LBUF I/O I Number of characters used in CBUF. C C 26-Jun-86 - [AFT] C----------------------------------------------------------------------- CHARACTER CBUF*(*) INTEGER NUM, LBUF INTEGER ITMP, IS, IC CHARACTER CTMP*5 C--- ITMP=NUM C - Bit 4(=16) is set for positive numbers and clear for negative. IS=16 IF(ITMP.LT.0) THEN IS=0 ITMP=-ITMP END IF C - Bits 6+7(=64,128) clear and Bit 5(=32) set, flags that this C - is the last byte in the number. CTMP(5:5)=CHAR(32+IS+IAND(ITMP,15)) ITMP=ITMP/16 IC=1 IF(ITMP.EQ.0) THEN C - Numbers in the range -15 to +15 can be sent in one byte. CBUF(LBUF+1:LBUF+1)=CTMP(5:5) ELSE C - Larger numbers require more bytes and are recorded 6 bits C - per byte with bit 7=(128) clear and bit 6(=64) set. 150 CTMP(5-IC:5-IC)=CHAR(64+IAND(ITMP,63)) IC=IC+1 ITMP=ITMP/64 IF(ITMP.NE.0) GOTO 150 CBUF(LBUF+1:LBUF+IC)=CTMP(6-IC:5) END IF LBUF=LBUF+IC RETURN END 0=(MXLEN-NINT(RBUF(1)))/2 J0=(MXWID-NINT(RBUF(2)))/2 ELSE I0=(MXWID-NINT(RBUF(1)))/2 J0=(MXLEN-NINT(RBUF(2)))/2 END IF CBUF(1:2)=CHAR(IVESC)//'"' LBUF=2 CALL GRLS04(J0,CBUF,LBUF) CALL GRLS04(pgplot/drivers/mfdriv.f010064400040640000322000000531720563041570600156640ustar00tjpcitmbr00000400000017C*MFDRIV -- PGPLOT Graphics MetaFile driver C+ SUBROUTINE MFDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Graphics MetaFile device. C C Version 1.0 - 1989 May 09 - S. C. Allendorf C First attempt at recreating the old C MetaFile device. Code based on original C version written by Tim Pearson. C Version 1.1 - 1989 May 20 - S. C. Allendorf C Make driver conform as closely as possible C to the standard without breaking GMFPLOT C and/or PGPLOT. Deviations from the C standard are marked with C *** DEVIATION ***. GMFPLOT and/or PGPLOT C would need to be changed to correct these C parts. C======================================================================= C C Supported device: The MetaFile device can be used to a store graphic C image in a device-independent disk file. C C Device type code: /FILE. C C Default device name: PGPLOT.GMF. C C Default view surface dimensions: Undefined (nominally 8 inches C square). C C Resolution: Undefined. C C Color capability: Color indices 0-255 are accepted and the C representation of all colors may be changed. The actual colors used C depend upon the output device chosen when the file is rendered. C C Input capability: None. C C File format: The metafile generated follow the "GSPC Metafile C Proposal" described in Computer Graphics (A.C.M.), Volume 13, number 3 C (August 1979). C C Obtaining hardcopy: Use the translator program GMFPLOT. C----------------------------------------------------------------------- LOGICAL CONT INTEGER*2 BUFFER(360), COMBUF(5), I0, I1, IB, IC, IG, IR, J0, J1 INTEGER*2 LASTI, LASTJ, NPICT, NPTS INTEGER*4 HW, IER, LUN, REMCAL REAL*4 RATIO, SCALE, XMAX, YMAX CHARACTER MSG*10 CHARACTER*(*) DEFNAM, TYPE PARAMETER (DEFNAM = 'PGPLOT.GMF') PARAMETER (TYPE = 'FILE (PGPLOT graphics metafile)') C----------------------------------------------------------------------- C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in MetaFile device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE CHR = TYPE NBUF = 0 LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 RBUF(2) = 32767.0 RBUF(3) = 0.0 RBUF(4) = 32767.0 RBUF(5) = 0.0 RBUF(6) = 255.0 NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE RBUF(1) = 4096.0 RBUF(2) = 4096.0 RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, Dashed lines, Area fill, C Thick lines, Rectangle fill, No line of pixels) C 40 CONTINUE CHR = 'HNDATRNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = DEFNAM NBUF = 0 LCHR = LEN (DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 RBUF(2) = 32767.0 RBUF(3) = 0.0 RBUF(4) = 32767.0 NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE RBUF(1) = 20.0 NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C Obtain a logical unit number. CALL GRGLUN (LUN) C Check for an error. IF (LUN .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit.') RBUF(2) = 0.0 RETURN ELSE RBUF(1) = LUN END IF C Open the output file. OPEN (UNIT = LUN, FILE = CHR(:LCHR), CARRIAGECONTROL = 'NONE', 1 DEFAULTFILE = DEFNAM, DISPOSE = 'DELETE', STATUS = 'NEW', 2 RECL = 180, FORM = 'UNFORMATTED', RECORDTYPE = 'FIXED', 3 IOSTAT = IER) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for MetaFile plot: ' // 1 CHR(:LCHR)) CALL GRFLUN (LUN) RBUF(2) = 0 RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN, NAME = CHR) LCHR = LEN (CHR) 95 IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 95 END IF END IF C Initialize the page counter. NPICT = 0 C Initialize the high water mark. HW = 0 C Send the BEGIN_METAFILE command, C requesting 15-bit precision. COMBUF(1) = '8001'X COMBUF(2) = '0001'X CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE C Send the END_METAFILE command. CALL GRMF01 (1, '8100'X, BUFFER, LUN, HW) C Flush the buffer. CALL GRMF02 (LUN, HW, BUFFER) C Close the file. CLOSE (LUN, DISPOSE = 'KEEP') C Deallocate the logical unit. CALL GRFLUN (LUN) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Increment the page number. NPICT = NPICT + 1 C *** DEVIATION *** C The MetaFile standard defines C the initial pen position to be at C (0, 0). This causes problems for C PGPLOT. C C Set the last position to unknown. LASTI = -1 LASTJ = -1 C Check to see if this is the first C picture. IF (NPICT .EQ. 1) THEN C Initialize the requested size and C and scale factor. XMAX = INT (RBUF(1) + 0.5) YMAX = INT (RBUF(2) + 0.5) SCALE = 1.0 C See if the user has requested a C specific size. IF (XMAX .NE. 32767.0 .OR. YMAX .NE. 32767.0) THEN C Calculate the the maximum C coordinates and the scale factor. COMBUF(2) = 32767 COMBUF(3) = 32767 RATIO = (YMAX + 1.0) / (XMAX + 1.0) IF (RATIO .LT. 1.0) THEN SCALE = 32767.0 / XMAX XMAX = 32767.0 YMAX = INT (32768.0 * RATIO - 0.5) COMBUF(3) = YMAX ELSE IF (RATIO .GT. 1.0) THEN SCALE = 32767.0 / YMAX XMAX = INT (32768.0 / RATIO - 0.5) YMAX = 32767.0 COMBUF(2) = XMAX ELSE SCALE = 32767.0 / XMAX XMAX = 32767.0 YMAX = 32767.0 END IF C Send DEFINE_NDC_SPACE command C along with X, Y, and Z ranges if C the user hasn't requested a C square plot. IF (RATIO .NE. 1.0) THEN COMBUF(1) = '8203'X COMBUF(4) = 0 CALL GRMF01 (4, COMBUF, BUFFER, LUN, HW) END IF END IF END IF C Flush buffer to get to a record C boundary. CALL GRMF02 (LUN, HW, BUFFER) C Send BEGIN_PICTURE command with C the picture number. COMBUF(1) = '9001'X COMBUF(2) = NPICT CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Scale and convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) I1 = INT (MIN (RBUF(3) * SCALE + 0.5, XMAX)) J1 = INT (MIN (RBUF(4) * SCALE + 0.5, YMAX)) C See if this is a continuation. CONT = (LASTI .EQ. I0) .AND. (LASTJ .EQ. J0) C Draw the line. CALL GRMF00 (I0, J0, I1, J1, CONT, BUFFER, LUN, HW) C Update the last position LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) C Draw the dot. CALL GRMF00 (I0, J0, I0, J0, .FALSE., BUFFER, LUN ,HW) C Update the last position. LASTI = I0 LASTJ = J0 RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Send a END_PICTURE command. CALL GRMF01 (1, '9100'X, BUFFER, LUN, HW) RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) C *** DEVIATION *** C The MetaFile standard defines C indices 0-7 and they are C different than those defined by C PGPLOT. C C Send the SET_COLOR command along C with the color index. COMBUF(1) = 'C101'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C 190 CONTINUE C Convert to an integer. IC = RBUF(1) C Send SET_LINESTYLE command along C width the requested linestyle. COMBUF(1) = 'C301'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C 200 CONTINUE IF (REMCAL .EQ. 0) THEN C First time, send DRAW_POLYGON and C the number of points. NPTS = RBUF(1) REMCAL = NPTS COMBUF(1) = 'A701'X COMBUF(2) = NPTS CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) ELSE C Second and succeeding calls, C MOVE to first point, DRAW to the C rest, and decrement the counter. COMBUF(1) = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) COMBUF(2) = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) IF (REMCAL .NE. NPTS) COMBUF(2) = IBSET (COMBUF(2), 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) REMCAL = REMCAL - 1 C *** DEVIATION *** C The MetaFile standard defines C the pen position after a polygon C draw to be at the first point. C This causes problems for PGPLOT. C C Set the pen position to unknown. IF (REMCAL .EQ. 0) LASTI = -1 END IF RETURN C C--- IFUNC = 21, Set color representation. ----------------------------- C 210 CONTINUE C *** DEVIATION *** C The MetaFile standard defines C indices 0-7 and does not allow C them to be changed. C C Convert input to integer IC = RBUF(1) IR = INT (MIN (32767.0, MAX (RBUF(2) * 32767.0, 0.0))) IG = INT (MIN (32767.0, MAX (RBUF(3) * 32767.0, 0.0))) IB = INT (MIN (32767.0, MAX (RBUF(4) * 32767.0, 0.0))) C Send DEFINE_COLOR_INDEX command C along with the index to be C defined and its definition. COMBUF(1) = 'C004'X COMBUF(2) = IC COMBUF(3) = IR COMBUF(4) = IG COMBUF(5) = IB CALL GRMF01 (5, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C 220 CONTINUE C *** DEVIATION *** C The MetaFile standard defines C linewidths differently than C PGPLOT. C C Convert to an integer. IC = RBUF(1) C Send SET_LINEWIDTH command along C with the requested line width. COMBUF(1) = 'C401'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C 240 CONTINUE C Scale and convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) I1 = INT (MIN (RBUF(3) * SCALE + 0.5, XMAX)) J1 = INT (MIN (RBUF(4) * SCALE + 0.5, YMAX)) C Simulate a hardware area fill. COMBUF(1) = 'A701'X COMBUF(2) = 4 CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I0 COMBUF(2) = J0 CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I1 COMBUF(2) = IBSET (J0, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I1 COMBUF(2) = IBSET (J1, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I0 COMBUF(2) = IBSET (J1, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) C *** DEVIATION *** C The MetaFile standard defines C the pen position after a polygon C draw to be at the first point. C This causes problems for PGPLOT. C C Set the pen position to unknown. LASTI = -1 RETURN C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C*GRMF00 -- PGPLOT MetaFile driver, draw a line segment C+ SUBROUTINE GRMF00 (I0, J0, I1, J1, CONT, BUFFER, LUN, HW) LOGICAL CONT INTEGER*2 BUFFER(360), I0, I1, J0, J1 INTEGER*4 HW, LUN C----------------------------------------------------------------------- C Draw a line. This requires a MOVE command (unless the starting point C is the same point as the end point of the last line) followed by a C DRAW command. C C Arguments: C C I0, J0 (input) The absolute device coordinates of the C starting point of the line C I1, J1 (input) The absolute device coordinates of the ending C point of the line C CONT (input) Flag denoting whether the line is a C continuation C BUFFER (input/output) The buffer C----------------------------------------------------------------------- INTEGER*2 OUTPUT(4) INTEGER*4 K C----------------------------------------------------------------------- C Initialize the counter. K = 0 C See if we need to MOVE first. IF (.NOT. CONT) THEN C Increment the counter. K = 2 C Output the coordinates. OUTPUT(1) = I0 OUTPUT(2) = J0 END IF C Send the x coordinate. OUTPUT(K + 1) = I1 C Mark the y coordinate as a DRAW C command and output it. OUTPUT(K + 2) = IBSET (J1, 15) C Increment the counter. K = K + 2 C Transfer the coordinates to the C buffer. CALL GRMF01 (K, OUTPUT, BUFFER, LUN, HW) C----------------------------------------------------------------------- RETURN END C*GRMF01 -- PGPLOT MetaFile driver, transfer chunks to output buffer C+ SUBROUTINE GRMF01 (N, CHUNKS, BUFFER, LUN, HW) INTEGER*4 HW, LUN, N INTEGER*2 CHUNKS(N), BUFFER(360) C C Transfer metafile chunks to output buffer. If the command would C overflow, it is flushed to the output device using routine GRMF02. C C Arguments: C C N (input) The number of chunks to transfer C CHUNKS (input) The chunks to transfer C BUFFER (input/output) The buffer C LUN (input) Fortran unit number for output C HW (input/output) Number of elements used in BUFFER C----------------------------------------------------------------------- INTEGER*4 I C----------------------------------------------------------------------- C Flush the buffer if the command C would overflow it. IF (HW + N .GT. 360) CALL GRMF02 (LUN, HW, BUFFER) C Transfer the chunks to the C buffer. DO 10 I = 1, N C Increment the high water mark. HW = HW + 1 C Move the chunk to the buffer. BUFFER(HW) = CHUNKS(I) 10 CONTINUE C----------------------------------------------------------------------- RETURN END C*GRMF02 -- PGPLOT MetaFile driver, flush metafile buffer contents C+ SUBROUTINE GRMF02 (LUN, HW, BUFFER) INTEGER*2 BUFFER(360) INTEGER*4 HW, LUN C C Flush metafile buffer contents. If the buffer is not full, it is C padded with NO_OPERATION commands. C C Arguments: C C LUN (input) Fortran unit number for output C HW (input/output) Number of elements used in BUFFER C BUFFER (input/output) The buffer C----------------------------------------------------------------------- INTEGER*4 I C----------------------------------------------------------------------- C See if the buffer has anything in C it. IF (HW .GT. 0) THEN C Fill buffer with NO_OPERATION C commands. DO 10 I = HW + 1 ,360 BUFFER(I) = '8400'X 10 CONTINUE C Write out the buffer. WRITE (LUN) BUFFER C Reset the high water mark. HW = 0 END IF C----------------------------------------------------------------------- RETURN END --------------------------------------- C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C 190 CONTINUE C Conpgplot/drivers/nudriv.f010064400040640000322000000264420635030002100156630ustar00tjpcitmbr00000400000017C*NUDRIV -- PGPLOT Null device driver C+ SUBROUTINE NUDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Null device (no graphical output) C C Version 1.0 - 1987 May 26 - T. J. Pearson. C Version 1.1 - 1988 Mar 23 - add rectangle fill. C Version 1.2 - 1992 Sep 3 - add line-of-pixels. C Version 1.3 - 1992 Sep 21 - add markers. C Version 1.4 - 1993 Apr 22 - add optional debugging. C Version 1.5 - 1994 Aug 31 - use image primitives. C Version 2.0 - 1996 Jan 22 - allow multiple active devices; C add QCR primitive. C Version 2.1 - 1997 Jun 13 - correctly initialize STATE. C C Supported device: The ``null'' device can be used to suppress C all graphic output from a program. If environment variable C PGPLOT_DEBUG is defined, some debugging information is C reported on standard output. C C Device type code: /NULL. C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Undefined (The device pretends to C be a hardcopy device with 1000 pixels/inch and a view surface 8in C high by 10.5in wide.) C C Resolution: Undefined. C C Color capability: Color indices 0--255 are accepted. C C Input capability: None. C C File format: None. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- C Notes: C Up to MAXDEV "devices" may be open at once. ACTIVE is the number C of the currently selected device, or 0 if no devices are open. C STATE(i) is 0 if device i is not open, 1 if it is open but with C no current picture, or 2 if it is open with a current picture. C C When debugging is enabled, open/close device and begin/end picture C calls are reported on stdout, and a cumulative count of all C driver calls is kept. C----------------------------------------------------------------------- CHARACTER*(*) DEVICE PARAMETER (DEVICE='NULL (Null device, no output)') INTEGER MAXDEV, MAXD1 PARAMETER (MAXDEV=8) PARAMETER (MAXD1=MAXDEV+1) INTEGER NOPCOD PARAMETER (NOPCOD=29) CHARACTER*10 MSG CHARACTER*32 TEXT CHARACTER*8 LAB(NOPCOD) INTEGER COUNT(NOPCOD), I, STATE(0:MAXDEV), L, NPIC(MAXDEV) INTEGER ACTIVE LOGICAL DEBUG INTEGER CTABLE(3,0:255), CDEFLT(3,0:15) SAVE COUNT, STATE, NPIC, DEBUG, CTABLE, CDEFLT, ACTIVE C DATA ACTIVE/-1/ DATA STATE/MAXD1*0/ DATA COUNT/NOPCOD*0/ DATA DEBUG/.FALSE./ DATA LAB /'qdev ', 'qmaxsize', 'qscale ', 'qcapab ', 1 'qdefnam ', 'qdefsize', 'qmisc ', 'select ', 2 'open ', 'close ', 'beginpic', 'line ', 3 'dot ', 'endpic ', 'set CI ', 'flush ', 4 'cursor ', 'eralpha ', 'set LS ', 'polygon ', 5 'set CR ', 'set LW ', 'escape ', 'rectangl', 6 'set patt', 'pix/imag', 'scaling ', 'marker ', 7 'query CR'/ DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, 1 000,000,255, 000,255,255, 255,000,255, 255,255,000, 2 255,128,000, 128,255,000, 000,255,128, 000,128,255, 3 128,000,255, 255,000,128, 085,085,085, 170,170,170/ C----------------------------------------------------------------------- C IF (ACTIVE.EQ.-1) THEN CALL GRGENV('DEBUG', TEXT, L) DEBUG = L.GT.0 ACTIVE = 0 END IF C IF (IFUNC.LT.1 .OR. IFUNC.GT.NOPCOD) GOTO 900 COUNT(IFUNC) = COUNT(IFUNC) + 1 GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260,270,280,290), IFUNC 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in NULL device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = DEVICE LCHR = LEN(DEVICE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 65535 RBUF(3) = 0 RBUF(4) = 65535 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1000.0 RBUF(2) = 1000.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, Dashed lines, Area fill, Thick C lines, Rectangle fill, Images, , , Markers, query color rep) C 40 CHR = 'HNDATRQNYM' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = 'NL:' LCHR = 3 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 10499 RBUF(3) = 0 RBUF(4) = 7999 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE I = RBUF(2) - 67890 IF (I.LT.1 .OR. I.GT.MAXDEV) THEN CALL GRWARN('internal error: NULL opcode 8') ELSE IF (STATE(I).GT.0) THEN ACTIVE = I ELSE CALL GRNU00(IFUNC,0) END IF RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- Find an inactive device, and select it DO 91 I=1,MAXDEV IF (STATE(I).EQ.0) THEN ACTIVE = I STATE(ACTIVE) = 1 GOTO 92 END IF 91 CONTINUE IF (DEBUG) CALL GRWARN ('09 Open workstation') CALL GRWARN('maximum number of devices of type NULL exceeded') RBUF(1) = 0 RBUF(2) = 0 NBUF = 2 RETURN C -- Initialize the new device 92 CONTINUE RBUF(1) = ACTIVE + 67890 RBUF(2) = 1 NBUF = 2 NPIC(ACTIVE) = 0 C -- Initialize color table DO 95 I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) 95 CONTINUE DO 96 I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 96 CONTINUE IF (DEBUG) THEN CALL GRFAO('09 Open workstation: device #', : L, TEXT, ACTIVE, 0, 0, 0) CALL GRWARN(TEXT(1:L)) END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 0 IF (DEBUG) THEN CALL GRFAO('10 Close workstation: device #', : L, TEXT, ACTIVE, 0, 0, 0) CALL GRWARN(TEXT(1:L)) CALL GRWARN('Device driver calls:') DO 101 I=1,NOPCOD IF (COUNT(I).GT.0) THEN WRITE (TEXT,'(3X,I2,1X,A8,I10)') I, LAB(I), COUNT(I) CALL GRWARN(TEXT) END IF 101 CONTINUE END IF RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF (STATE(ACTIVE).NE.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 2 NPIC(ACTIVE) = NPIC(ACTIVE)+1 IF (DEBUG) THEN CALL GRFAO('11 Begin picture # on device #', : L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0) CALL GRWARN(TEXT(:L)) END IF RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) STATE(ACTIVE) = 1 IF (DEBUG) THEN CALL GRFAO('14 End picture # on device #', : L, TEXT, NPIC(ACTIVE), ACTIVE, 0,0) CALL GRWARN(TEXT(:L)) END IF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) I = RBUF(1) CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE IF (DEBUG.AND.STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=25, Not implemented ----------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=27, Scaling info -- ----------------------------------------- C 270 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) RETURN C C--- IFUNC=28, Draw marker --------------------------------------------- C 280 CONTINUE IF (STATE(ACTIVE).NE.2) CALL GRNU00(IFUNC,STATE(ACTIVE)) C WRITE (*,'(1X,A,I4,1X,3F10.1)') 'MARKER', NINT(RBUF(1)), RBUF(2), C 1 RBUF(3), RBUF(4) RETURN C C--- IFUNC=29, Query color representation. ----------------------------- C 290 CONTINUE IF (STATE(ACTIVE).LT.1) CALL GRNU00(IFUNC,STATE(ACTIVE)) I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 RETURN C----------------------------------------------------------------------- END SUBROUTINE GRNU00(IFUNC, STATE) INTEGER IFUNC, STATE C C PGPLOT NULL device driver: report error C----------------------------------------------------------------------- INTEGER L CHARACTER*80 MSG C CALL GRFAO('++ internal error: driver in state # for opcode #', : L, MSG, STATE, IFUNC, 0, 0) CALL GRWARN(MSG(1:L)) RETURN END pgplot/drivers/pgdriv.f010064400040640000322000000261400667701357700156770ustar00tjpcitmbr00000400000017C*PGDRIV -- PGPLOT metafile driver C+ SUBROUTINE PGDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for PGPLOT metafile (private format). C C----------------------------------------------------------------------- INTEGER DWD, DHT, DRES CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE= 'PGMF (PGPLOT metafile)') PARAMETER (DEFNAM='pgplot.pgmf') PARAMETER (DWD=6400, DHT=4800, DRES=1000) C INTEGER WIDTH, HEIGHT SAVE WIDTH, HEIGHT INTEGER NSYM, MFAC INTEGER IER, I0, J0, I1, J1, L, LL, LASTI, LASTJ, UNIT, I SAVE LASTI, LASTJ, UNIT INTEGER CI, LW, LS, NPTS, NPAGE, IOERR, LFNAME SAVE LW, LS, NPTS, NPAGE, IOERR, LFNAME INTEGER STATE, INPIC SAVE STATE, INPIC INTEGER GROPTX, GRCTOI LOGICAL STDOUT SAVE STDOUT INTEGER RVALUE(0:255), GVALUE(0:255), BVALUE(0:255) SAVE RVALUE, GVALUE, BVALUE INTEGER OP(0:255) SAVE OP CHARACTER*120 INSTR, MSG CHARACTER*255 FNAME SAVE FNAME REAL RINIT(0:15), GINIT(0:15), BINIT(0:15) SAVE RINIT, GINIT, BINIT DATA RINIT 1 / 1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 2 1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67/ DATA GINIT 1 / 1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00, 2 0.50, 1.00, 1.00, 0.50, 0.00, 0.00, 0.33, 0.67/ DATA BINIT 1 / 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 0.00, 2 0.00, 0.00, 0.50, 1.00, 1.00, 0.50, 0.33, 0.67/ DATA STATE/0/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,900,180,900,200, 2 210,220,230,240,900,260,900,280,290), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = -1 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = REAL(DRES) RBUF(2) = REAL(DRES) RBUF(3) = 5 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C 40 CONTINUE CHR = 'HNNATRQNYM' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(3) = 0 RBUF(2) = WIDTH RBUF(4) = HEIGHT NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 8 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT metafile is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF DO 91 CI=0,15 RVALUE(CI) = NINT(255*RINIT(CI)) GVALUE(CI) = NINT(255*GINIT(CI)) BVALUE(CI) = NINT(255*BINIT(CI)) 91 CONTINUE DO 93 CI=16,255 RVALUE(CI) = 0 GVALUE(CI) = 0 BVALUE(CI) = 0 93 CONTINUE C -- Device dimensions WIDTH = DWD HEIGHT = DHT CALL GRGENV('PGMF_WIDTH', INSTR, L) LL = 1 IF (L.GT.0) WIDTH = GRCTOI(INSTR(:L),LL) CALL GRGENV('PGMF_HEIGHT', INSTR, L) LL = 1 IF (L.GT.0) HEIGHT = GRCTOI(INSTR(:L),LL) STDOUT =CHR(1:LCHR).EQ.'-' IF (STDOUT) THEN UNIT = 6 C -- machine-dependent! ELSE CALL GRGLUN(UNIT) END IF NBUF = 2 RBUF(1) = UNIT IF (.NOT.STDOUT) THEN IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN MSG = 'Cannot open output file for PGPLOT metafile: '// 1 CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 94 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 94 END IF RBUF(2) = 1 FNAME = CHR(:LCHR) LFNAME = LCHR END IF ELSE RBUF(2) = 1 FNAME = '-' LFNAME= 1 END IF STATE = 1 IOERR = 0 LASTI = -1 LASTJ = -1 LW = 1 LS = 1 NPTS = 0 INPIC = 0 NPAGE = 0 CALL GRPG02(IOERR, UNIT, '%PGMF (PGPLOT metafile)') CALL GRUSER(INSTR, L) IF (L.GT.0) CALL GRPG02(IOERR, UNIT, '% Creator: '//INSTR(1:L)) CALL GRDATE(INSTR, L) IF (L.GT.0) CALL GRPG02(IOERR, UNIT, '% Date: '//INSTR(1:L)) RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE IF (.NOT.STDOUT) THEN CLOSE (UNIT, IOSTAT=IOERR) IF (IOERR.NE.0) THEN CALL GRWARN('Error closing PGPLOT metafile '//FNAME(:LFNAME)) END IF CALL GRFLUN(UNIT) END IF STATE = 0 RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE WIDTH = RBUF(1) HEIGHT = RBUF(2) NPAGE = NPAGE+1 INPIC = 1 CALL GRFAO('B# # # #', L, INSTR, NPAGE, WIDTH, HEIGHT, DRES) CALL GRPG02(IOERR, UNIT, INSTR(:L)) DO 111 I=0,255 OP(I) = 0 111 CONTINUE CALL GRFAO('C# # # #', L, INSTR, 0, RVALUE(0), GVALUE(0), : BVALUE(0)) CALL GRPG02(IOERR, UNIT, INSTR(1:L)) OP(0) = 1 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN C -- suppress zero-length continuation segment IF (I0.EQ.I1 .AND. J0.EQ.J1) RETURN CALL GRFAO('L# #', L, INSTR, (I1-I0), (J1-J0), 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(:L)) ELSE CALL GRFAO('M# #', L, INSTR, I0, J0, 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(:L)) CALL GRFAO('L# #', L, INSTR, (I1-I0), (J1-J0), 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(:L)) END IF LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) CALL GRFAO('D# #', L, INSTR, I1, J1, 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(:L)) LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE CALL GRPG02(IOERR, UNIT, 'E') INPIC = 0 RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) IF (INPIC.EQ.1) THEN IF (OP(CI).EQ.0) THEN CALL GRFAO('C# # # #', L, INSTR, CI, RVALUE(CI), : GVALUE(CI), BVALUE(CI)) CALL GRPG02(IOERR, UNIT, INSTR(1:L)) OP(CI) = 1 END IF CALL GRFAO('I#', L, INSTR, CI, 0, 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(:L)) LASTI = -1 END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) CALL GRFAO('Y#', L, INSTR, NPTS, 0, 0, 0) ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) CALL GRFAO('X# #', L, INSTR, I0, J0, 0, 0) END IF CALL GRPG02(IOERR, UNIT, INSTR(1:L)) LASTI = -1 RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE CI = RBUF(1) RVALUE(CI) = NINT(255*RBUF(2)) GVALUE(CI) = NINT(255*RBUF(3)) BVALUE(CI) = NINT(255*RBUF(4)) OP(CI) = 0 RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Convert requested line width, unit 1/200 inch, to device units) C 220 CONTINUE LW = NINT(DRES*RBUF(1)/200.0) CALL GRFAO('W#', L, INSTR, LW, 0, 0, 0) CALL GRPG02(IOERR, UNIT, INSTR(1:L)) LASTI = -1 RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE CALL GRPG02(IOERR, UNIT, CHR(:LCHR)) LASTI = -1 RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE CALL GRFAO('R# # # #', L, INSTR, NINT(RBUF(1)), NINT(RBUF(2)), : NINT(RBUF(3)), NINT(RBUF(4))) CALL GRPG02(IOERR, UNIT, INSTR(1:L)) LASTI = -1 RETURN C C--- IFUNC=26, Image.--------------------------------------------------- C 260 CONTINUE C Not yet implemented RETURN C C--- IFUNC=28, Marker.-------------------------------------------------- C 280 CONTINUE NSYM = NINT(RBUF(1)) I1 = NINT(RBUF(2)) J1 = NINT(RBUF(3)) MFAC = NINT(1000.0*RBUF(4)) CALL GRFAO('S# # # #', L, INSTR, NSYM, I1, J1, MFAC) CALL GRPG02(IOERR, UNIT, INSTR(1:L)) LASTI = -1 RETURN C C--- IFUNC=29, Query color representation.------------------------------ C 290 CONTINUE CI = NINT(RBUF(1)) NBUF = 4 RBUF(2) = RVALUE(CI)/255.0 RBUF(3) = GVALUE(CI)/255.0 RBUF(4) = BVALUE(CI)/255.0 RETURN C C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG, 1 '(''Unimplemented function in PG device driver: '',I10)') IFUNC CALL GRWARN(MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END C*GRPG02 -- PGPLOT metafile driver, copy buffer to file C+ SUBROUTINE GRPG02 (IER, UNIT, S) C C Support routine for PGdriver: write character string S on C specified Fortran unit. C C Error handling: if IER is not 0 on input, the routine returns C immediately. Otherwise IER receives the I/O status from the Fortran C write (0 => success). C----------------------------------------------------------------------- INTEGER IER, UNIT CHARACTER*(*) S C IF (IER.EQ.0) THEN WRITE (UNIT, '(A)', IOSTAT=IER) S IF (IER.NE.0) CALL 1 GRWARN('++WARNING++ Error writing PGPLOT metafile') END IF C----------------------------------------------------------------------- END 120 INSTR, MSG CHARACTER*255 FNAME SAVE FNAME REAL RINIT(0:15), GINIT(0:15), BINIT(0:15) SAVE RINIT, GINIT, BINIT DATA RINIT 1 / 1.00, 0.00, 1.00, 0.00, 0.00, 0.00, 1.00, 1.00, 2 1.00, 0.50, 0.00, 0.00, 0.50, 1.00, 0.33, 0.67/ DATA GINIT 1 / 1.00, 0.00, 0.00, 1.00, 0.00, 1.00, 0.00, 1.00, 2 0.50, 1.pgplot/drivers/qmdriv.f010064400040640000322000000406760566772407200157150ustar00tjpcitmbr00000400000017C*GRQM00 -- PGPLOT QMS/QUIC driver SUBROUTINE QMDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for QUIC devices (QMS and Talaris 800/1200/1500/2400) C----------------------------------------------------------------------- C Version 0.1 - 1987 Oct 22 - Patrick P. Murphy, NRAO/VLA [PPM] C Version 0.2 - 1987 Oct 28 - [PPM] Fix backwards and scale bugs C Version 1.0 - 1987 Nov 03 - [PPM] Don't form feed if nothing drawn. C Version 1.1 - 1987 Nov 03 - [PPM] No formfeed at very end of file C Version 2.0 - 1987 Nov 18 - [PPM] Get scaling done right. C Version 2.1 - 1991 Jun 28 - [TJP] Standardization. C Version 2.2 - 1991 Nov 6 - [TJP] Standardization. C Version 3.0 - 1994 Feb 25 - [TJP] Combine portrait and landscape C modes in one file. C----------------------------------------------------------------------- C C Supported device: Any QMS or Talaris printer that accepts the QUIC C page description language. 4-bit mode is used. C C Device type code: /QMS (landscape mode 1) C /VQMS (portrait mode 2) C C Default file name: PGPLOT.QMPLOT. C C Default view surface dimensions: C 10.25 inches horizontal x 7.75 inches vertical (landscape mode), C 7.75 inches horizontal x 10.25 inches vertical (portrait mode), C margins of 0.5 inches on top and left of page. C C Resolution: The driver uses coordinate increments of 1/1000 inch. C The true resolution is device-dependent; at time of C writing, it is typically 300 dots per inch. C C Color capability: Color indices 0 (erase), and 1 (black) are C supported. Requests for other color indices are C converted to 1. It is not possible to change color C representation. C C Input capability: None. C C File format: Ascii, variable length records (max 130 bytes); carriage C return ("LIST") carriage control. This length can be C easily changed if needed. C C Obtaining hardcopy: send the file to an appropriate printer. C----------------------------------------------------------------------- C CHARACTER*(*) DEVTPL, DEVTPP, DEFNAM PARAMETER (DEFNAM='PGPLOT.QMPLOT') PARAMETER (DEVTPL='QMS (QUIC/QMS file, landscape orientation)') PARAMETER (DEVTPP='VQMS (QUIC/QMS file, portrait orientation)') C CHARACTER*130 BUFFER CHARACTER*16 HEXSTR CHARACTER*10 MSG CHARACTER*40 TEMP INTEGER UNIT, IER, BUFLEN, MAXLEN, I0, J0, I1, J1, NPTS, IC, : ISTYLE, LINWID, GROPTX REAL QXSIZE, QYSIZE, QXSCAL, QYSCAL LOGICAL NOTHIN, ENDFIL C C ---- Change MAXLEN if you want a shorter or longer max output line C ---- length. Also change the declared length of BUFFER too! The C ---- Q*SIZE parameters are the physical size of the plot (used more C ---- than once here) in resolution units (1/1000 inch). The Q*SCAL C ---- parameters are PGPLOT-modifiable scale factors. C PARAMETER (MAXLEN = 130, : QXSIZE = 10250.0, : QYSIZE = 7750.00) C SAVE UNIT, IC, BUFFER, BUFLEN, NPTS, QXSCAL, QYSCAL, NOTHIN, : ENDFIL C DATA HEXSTR /'0123456789ABCDEF'/ C C======================================================================= C C ---- Do the best one can in F77 for a "case" statement. -------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC C C ---- Unknown opcode/function; most likely a logic error somewhere ---- C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in QMS'// : ' device driver:'//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 IF (MODE.EQ.1) THEN CHR = DEVTPL LCHR = LEN(DEVTPL) ELSE IF (MODE.EQ.2) THEN CHR = DEVTPP LCHR = LEN(DEVTPP) ELSE CALL GRWARN('Internal error in QMDRIV') END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C Units are in device co-ordinates (1/1000 inches) C 20 IF (MODE.EQ.1) THEN RBUF(2) = QXSIZE RBUF(4) = QYSIZE ELSE RBUF(2) = QYSIZE RBUF(4) = QXSIZE END IF RBUF(1) = 0.0 RBUF(3) = 0.0 RBUF(5) = 0.0 RBUF(6) = 1.0 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = 1000.0 RBUF(2) = 1000.0 C C (multiple strokes are spaced by 3.333 pixels, or 1/300 inch) C RBUF(3) = 3.333 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Hardcopy, No cursor, Dashed lines, Area fill, Thick lines) C 40 CHR = 'HNDATNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C (in device coordinates). C 60 IF (MODE.EQ.1) THEN RBUF(2) = QXSIZE RBUF(4) = QYSIZE ELSE RBUF(2) = QYSIZE RBUF(4) = QXSIZE END IF RBUF(1) = 0.0 RBUF(3) = 0.0 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C Currently scale factor for "obsolete" character set of old GRPCKG C routines (not used by PGPLOT routines). Value copied from IMAGEN C driver -- I assume this is a good value (PPM 871026). C 70 RBUF(1) = 8.0 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C Future option, nothing done yet. (Multiple devices open at one C time will be allowed later; this opcode will select active device). C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C C -- Get a Unit number. C CALL GRGLUN(UNIT) C C -- Open the file. C NBUF = 2 RBUF(1) = UNIT IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN TEMP = CHR(1:LCHR) CALL GRWARN('Cannot open output file for QMS'// : ' plot: '//TEMP) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF C C -- initialization C IC = 1 BUFFER = ' ' BUFLEN = 0 NPTS = 0 QXSCAL = 1.0 QYSCAL = 1.0 NOTHIN = .TRUE. C C -- Initialize QUIC, get into free format, out of other possible C -- modes (vector graphics, word processing), reset interpretation: C -- Set landscape/portrait mode, set margins, enter vector C graphics mode C BUFLEN = 1 CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER = '^PY^-' BUFLEN = 5 CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(1:38) = '^F^IGE^G^IWE^G^IP0000^G^ISYNTAX00000^G' IF (MODE.EQ.1) THEN BUFFER(39:80) = '^IOL^G^IMH0050010750^G^IMV0050008250^G^IGV' ELSE BUFFER(39:80) = '^IOP^G^IMH0050008250^G^IMV0050010750^G^IGV' END IF BUFLEN = 80 CALL GRQM00 (UNIT, BUFFER, BUFLEN) RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE IF (NOTHIN) THEN C C -- Nothing was plotted so no need to keep the file around. C CLOSE (UNIT) C ELSE C C -- see if the last call was end picture; if so, remove formfeed C (this assumes the printer/queue combination will supply the C form feeds; if not, comment out this next line). C IF (ENDFIL) BUFLEN = BUFLEN - 2 C C -- Flush out anything left in the buffer C IF (BUFLEN .GT. 0) CALL GRQM00 (UNIT, BUFFER, BUFLEN) C C -- Don't need to formfeed; end picture will do that. C BUFFER = '^IGE^G^O^-' BUFLEN = 10 CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER = '^PN^-' BUFLEN = 5 CALL GRQM00 (UNIT, BUFFER, BUFLEN) CLOSE (UNIT, STATUS='KEEP') ENDIF C C -- Return UNIT to free pool. C CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture and possibly rescale ----------------------- C 110 CONTINUE ENDFIL = .FALSE. IF (MODE.EQ.1) THEN QXSCAL = MIN (1., RBUF(1) / QXSIZE) QYSCAL = MIN (1., RBUF(2) / QYSIZE) ELSE QXSCAL = MIN (1., RBUF(2) / QXSIZE) QYSCAL = MIN (1., RBUF(1) / QYSIZE) END IF RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C When I copied the Imagen driver, I got output backwards in the C X direction (mirrored). Hence I mirror it back now. C 120 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. IF (IC.EQ.0) RETURN IF (MODE.EQ.1) THEN I0 = NINT((QXSIZE - RBUF(1)) * QXSCAL) J0 = NINT(RBUF(2) * QYSCAL) I1 = NINT((QXSIZE - RBUF(3)) * QXSCAL) J1 = NINT(RBUF(4) * QYSCAL) ELSE I0 = NINT(RBUF(1) * QYSCAL) J0 = NINT((QXSIZE - RBUF(2)) * QXSCAL) I1 = NINT(RBUF(3) * QYSCAL) J1 = NINT((QXSIZE - RBUF(4)) * QXSCAL) END IF 125 CONTINUE IF (BUFLEN+13 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+2) = '^U' WRITE (BUFFER(BUFLEN+3:BUFLEN+13), '(I5.5,1H:,I5.5)') I0, J0 BUFLEN = BUFLEN + 13 IF (BUFLEN+13 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+2) = '^D' WRITE (BUFFER(BUFLEN+3:BUFLEN+13), '(I5.5,1H:,I5.5)') I1, J1 BUFLEN = BUFLEN + 13 RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C QUIC takes care of dot size by the ^PW (pen width) command so we C don't have to worry about it here. Just draw to same point and C let the "draw line" code handle it. C 130 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. IF (IC.EQ.0) RETURN IF (MODE.EQ.1) THEN I0 = NINT((QXSIZE - RBUF(1)) * QXSCAL) J0 = NINT(RBUF(2) * QYSCAL) ELSE I0 = NINT(RBUF(1) * QYSCAL) J0 = NINT((QXSIZE - RBUF(2)) * QXSCAL) END IF I1 = I0 J1 = J0 GOTO 125 C C--- IFUNC=14, End picture --------------------------------------------- C This means do a form feed. QUIC allows form feeds within vector C graphics mode so just put it in the stream. C Changed 871103 [PPM] so that no formfeed done if "NOTHIN" is true. C That means there is nothing on the paper. C Changed again (same date, person): set flag for end workstation C 140 CONTINUE ENDFIL = .TRUE. IF (.NOT. NOTHIN) THEN IF (BUFLEN+2 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+2) = '^,' BUFLEN = BUFLEN + 2 ENDIF RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C Hardcopy so ignore it C 160 CONTINUE C CALL GRQM00 (UNIT, BUFFER, BUFLEN) Not needed! RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented, hardcopy device. Return error code. C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen so ignore it). C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE ISTYLE = NINT(RBUF(1)) IF (ISTYLE .LT. 1) ISTYLE = 1 IF (ISTYLE .GT. 5) ISTYLE = 5 C C -- Convert PGPLOT line styles 1 thru 5 to QUIC equivalents C GOTO (191,192,193,194,195) ISTYLE C C Select ISTYLE in CASE: C Full line 191 ISTYLE = 0 GOTO 196 C Long dashes 192 ISTYLE = 1 GOTO 196 C Dash-dot 193 ISTYLE = 7 GOTO 196 C Dotted 194 ISTYLE = 2 GOTO 196 C Dash-dot-dot-dot 195 ISTYLE = 9 GOTO 196 C End SELECT/CASE on ISTYLE 196 CONTINUE C C -- I use HEXSTR here for system-independence and also in case the C -- PGPLOT package ever adds more line styles. C IF (BUFLEN+3 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+2) = '^V' ISTYLE = ISTYLE + 1 BUFFER(BUFLEN+3:BUFLEN+3) = HEXSTR(ISTYLE:ISTYLE) BUFLEN = BUFLEN + 3 RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (IC .EQ. 0) RETURN C C -- Use NPTS as our indicator of whether this is first time or not C IF (NPTS.EQ.0) THEN C C -- First time so set number of points in polygon C NPTS = RBUF(1) IF (BUFLEN+8 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) C C -- Use black fill, no border (in case PGPLOT doesn't go back to C the last point) -------------------------------------------- C BUFFER (BUFLEN+1:BUFLEN+8) = '^PF020^U' BUFLEN = BUFLEN + 8 ELSE C C -- Second or other time so bump NPTS and draw to next vertex C IF (NOTHIN) NOTHIN = .FALSE. NPTS = NPTS - 1 IF (MODE.EQ.1) THEN I0 = NINT((QXSIZE - RBUF(1)) * QXSCAL) J0 = NINT(RBUF(2) * QYSCAL) ELSE I0 = NINT(RBUF(1) * QYSCAL) J0 = NINT((QXSIZE - RBUF(2)) * QXSCAL) END IF IF (BUFLEN+13 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) WRITE (BUFFER(BUFLEN+1:BUFLEN+11), '(I5.5,1H:,I5.5)') I0, J0 BUFFER(BUFLEN+12:BUFLEN+13) = '^D' BUFLEN = BUFLEN + 13 IF (NPTS .EQ. 0) THEN C C -- get rid of last ^D and give the Polygon fill command C BUFLEN = BUFLEN - 2 BUFFER(BUFLEN+1:BUFLEN+2) = ' ' IF (BUFLEN+3 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+3) = '^PS' BUFLEN = BUFLEN + 3 END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored. Will we ever get color laser printers?) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE C C -- QUIC pen width is in dots (1/300 inch) so convert from 1/200's. C LINWID = NINT(RBUF(1) * 1.5) IF (LINWID .LT. 1) LINWID = 1 IF (LINWID .GT. 31) LINWID = 31 IF (BUFLEN+5 .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+3) = '^PW' WRITE (BUFFER(BUFLEN+4:BUFLEN+5), '(I2.2)') LINWID BUFLEN = BUFLEN + 5 RETURN C C--- IFUNC=23, Escape -------------------------------------------------- C Note that the NOTHIN flag which indicates if there is anything C written on the paper is set here regardless of the content of C the escape characters. C 230 CONTINUE IF (NOTHIN) NOTHIN = .FALSE. IF (LCHR .GT. MAXLEN) THEN WRITE (MSG(1:4), '(I4)') MAXLEN CALL GRWARN('Sorry, maximum line size ('//MSG(1:4)// : ') exceeded for device type QMS') NBUF = -1 ELSE C C -- WARNING! Anyone using the escape mechanism to send stuff C to the QMS had better remember (a) the QMS is ASSUMED by C the driver to be in vector graphics mode, and (b) you better C darn well put it back in the same vector mode!!! If not, C well, you get what you deserve then. C IF (BUFLEN+LCHR .GE. MAXLEN) CALL GRQM00 (UNIT, BUFFER, BUFLEN) BUFFER(BUFLEN+1:BUFLEN+LCHR) = CHR(1:LCHR) BUFLEN = BUFLEN + LCHR ENDIF C RETURN C----------------------------------------------------------------------- END C*GRQM00 -- PGPLOT QMS/QUIC driver, flush buffer C+ SUBROUTINE GRQM00 (LUN, BUF, SIZ) CHARACTER*(*) BUF INTEGER LUN, SIZ C-- WRITE (LUN, '(A)') BUF(1:SIZ) BUF(1:LEN(BUF)) = ' ' SIZ = 0 END pgplot/drivers/tfdriv.f010064400040640000322000000350440574332627700157020ustar00tjpcitmbr00000400000017C*TFDRIV -- PGPLOT Tektronix file driver C+ SUBROUTINE TFDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Tektronix disk file. This version uses C the extended (12-bit) addressing of the Tektronix-4014. C C Version 1.0 - 1987 Aug 18 - T. J. Pearson. C Version 1.1 - 1995 Mar 20 - David R. Chang (chang@firm.drea.dnd.ca): C Optimized coordinate output. C Implemented escape function. C C C Supported device: disk file which may be printable on a C Tektronix-compatible device. C C Device type code: /TFILE. C C Default device name: PGPLOT.TFPLOT. C C Default view surface dimension: Depends on printer; nominally C 400 pixels/inch giving 10.24 in (horizontal) x 7.80 in (vertical). C C Resolution: The coordinate system used for Tektronix emulation is C 4096 x 3120 pixels. C C Color capability: Only color index 1 is supported. Primitives drawn C in "erase" mode (color index 0) are ignored (not erased). It is not C possible to change color representation. C C Input capability: None. C C File format: Binary, variable length records (maximum 1024 bytes); C no carriage-control attribute. C C Obtaining hardcopy: depends on the available printer. e.g., for an C Imagen printer with IMPRINT software, C $ IMPRINT/STYLE=TEKTRONIX file.type C C Note: the file cannot easily be displayed on a Tektronix-compatible C *terminal* because it contains control characters which will be C interpreted by the operating system. The terminal must be set to C "Passall" mode before the file can be displayed. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (DEFNAM='PGPLOT.TFPLOT') PARAMETER (TYPE='TFILE (disk file in Tektronix format)') INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER BUFFER INTEGER BUFLEV INTEGER UNIT, IER, I0, I1, J0, J1 INTEGER I, LASTI, LASTJ INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER IC BYTE TKBUF(12) INTEGER NW BYTE TKTERM(6) DATA TKTERM/29, 55, 127, 32, 64, 31/ SAVE BUFFER, BUFLEV, IC, LASTI, LASTJ, TKTERM, UNIT C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in TFILE device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 4095 RBUF(3) = 0 RBUF(4) = 3119 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C (Nominal values) C 30 RBUF(1) = 400.0 RBUF(2) = 400.0 C (multiple strokes are spaced by 2 pixels, or 1/200 inch; ideally C the printer `pen' width should be 1/200 inch) RBUF(3) = 2 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (Non-interactive, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'NNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 4095 RBUF(3) = 0 RBUF(4) = 3119 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 8.0 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- allocate buffer IER = GRGMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER RETURN END IF C -- open device CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER, 3 RECL=256) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IC = 1 LASTI = -1 LASTJ = -1 BUFLEV=0 C -- no device initialization required RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRWARN('Error deallocating plot buffer.') CALL GRGMSG(IER) END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C -- erase screen; no wait required TKBUF(1) = 29 TKBUF(2) = 27 TKBUF(3) = 12 TKBUF(4) = 24 NW = 4 LASTI = -1 GOTO 1000 C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE IF (IC.EQ.0) RETURN I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) CALL GRTF01(LASTI, LASTJ, I0, J0, I1, J1, TKBUF, NW) GOTO 1000 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE IF (IC.EQ.0) RETURN I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) CALL GRTF01(LASTI, LASTJ, I0, J0, I0, J0, TKBUF, NW) GOTO 1000 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE CALL GRTF02(TKTERM,6,%val(BUFFER),BUFLEV,UNIT) CALL GRTF03(%val(BUFFER), UNIT, BUFLEV) LASTI = -1 RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C Not implemented. C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C 230 CONTINUE IF (LCHR.LE.BUFSIZ) THEN LASTI = -1 CALL GRTF02(%ref(CHR),LCHR,%val(BUFFER),BUFLEV,UNIT) ENDIF RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C (Not implemented: should not be called) C 240 CONTINUE GOTO 900 C C--- Send the command. ------------------------------------------------- C 1000 CALL GRTF02(TKBUF,NW,%val(BUFFER),BUFLEV,UNIT) RETURN C----------------------------------------------------------------------- END C*GRTF01 -- PGPLOT Tektronix file driver, draw line segment C+ SUBROUTINE GRTF01(LASTI, LASTJ, I0, J0, I1, J1, TKBUF, NW) INTEGER LASTI, LASTJ, I0, J0, I1, J1, NW BYTE TKBUF(*) C C This routine draws a line from (I0, J0) to (I1, J1). If LASTI>=0 C assume that the cursor is at the position is at (LASTI, LASTJ). C For this case, a minimum length move is done from (LASTI, LASTJ) to C the nearer point. Of course, if (LASTI, LASTJ) and the nearer point C are the same, then no bytes of positioning data are generated and C sent to the file. If LASTI<0 then a move is done with the C coordinate fully specified. In both cases the line end point C is specified using the fewest number of bytes allowed by the protocol. C Upon return, LASTI,LASTJ will contain the current cursor position. C Note: The 'delete' character (127) can occur in LOY or EXTRA byte; C it can be replaced by escape-? if desired. C C Arguments: C LASTI,LASTJ (in/out) : current position C I0, J0 (in/out) : device coordinates of the starting point. C I1, J1 (in/out) : device coordinates of the end point. C TKBUF (out) : buffer for instruction. C NW (out) : Number of valid characters in TKBUF. C C 1995-Mar-17 - Created from GRTT01 - [DRC] C----------------------------------------------------------------------- INTEGER GS PARAMETER (GS = 29) INTEGER MASKLX, MASKHX PARAMETER (MASKLX = 64, MASKHX = 32) INTEGER MASKLY, MASKHY PARAMETER (MASKLY = 96, MASKHY = 32) INTEGER MASKEX PARAMETER (MASKEX = 96) C INTEGER ID0, ID1, ITMP INTEGER IEX, ILOX, IHIX, ILOY, IHIY C NW = 0 IF(LASTI.LT.0) THEN C Last position is invalid, therefore do a dark vector move with all C coordinates specified. NW=NW+1 TKBUF(NW) = GS IHIY = J0/128 ILOY = MOD(J0/4, 32) IHIX = I0/128 ILOX = MOD(I0/4, 32) IEX = 4*MOD(J0, 4) + MOD(I0, 4) TKBUF(NW+1) = MASKHY + IHIY TKBUF(NW+2) = MASKEX + IEX TKBUF(NW+3) = MASKLY + ILOY TKBUF(NW+4) = MASKHX + IHIX TKBUF(NW+5) = MASKLX + ILOX NW = NW + 5 ELSE C Last position is valid, move pen to nearest end point of line. ID0=ABS(LASTI-I0)+ABS(LASTJ-J0) ID1=ABS(LASTI-I1)+ABS(LASTJ-J1) IF(ID1.LT.ID0) THEN C Swap coordinates to minimize 'pen motion'. For optimized coordinates C this can reduce the amount of I/O to the file. ITMP=I0 I0=I1 I1=ITMP ITMP=J0 J0=J1 J1=ITMP ITMP=ID0 ID0=ID1 ID1=ITMP END IF IF(ID0.NE.0 .OR. ID1.NE.0) THEN C Position has changed, so do a move operation. NW=NW+1 TKBUF(NW)=GS CALL GRTF04(LASTI,LASTJ,I0,J0,TKBUF,NW) END IF END IF C C File is now in graph mode, and the `pen' has been positioned. C Do an optimized draw. CALL GRTF04(I0,J0,I1,J1,TKBUF,NW) C C Remember current position. LASTI=I1 LASTJ=J1 RETURN C----------------------------------------------------------------------- END C*GRTF02 -- PGPLOT Tektronix file driver, transfer data to buffer C+ SUBROUTINE GRTF02 (INSTR, N, BUFFER, HWM, UNIT) INTEGER N, HWM, UNIT BYTE INSTR(*), BUFFER(*) C C Arguments: C INSTR (input) : text of instruction (bytes). C N (input) : number of bytes to transfer. C BUFFER (input) : output buffer. C HWM (in/out) : number of bytes used in BUFFER. C UNIT (input) : channel number for output (when buffer is full). C C Subroutines called: C GRTF03 C----------------------------------------------------------------------- INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER I C----------------------------------------------------------------------- IF (HWM+N.GE.BUFSIZ) CALL GRTF03(BUFFER, UNIT, HWM) DO 10 I=1,N HWM = HWM + 1 BUFFER(HWM) = INSTR(I) 10 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRTF03 -- PGPLOT Tektronix file driver, copy buffer to file C+ SUBROUTINE GRTF03 (BUFFER, UNIT, N) BYTE BUFFER(*) INTEGER UNIT, N C C Arguments: C BUFFER (input) address of buffer to be output C UNIT (input) unit number for output C N (input) number of bytes to transfer C (output) set to zero C----------------------------------------------------------------------- INTEGER J C----------------------------------------------------------------------- IF (N.GT.0) WRITE (UNIT) (BUFFER(J),J=1,N) N = 0 RETURN C----------------------------------------------------------------------- END C*GRTF04 -- PGPLOT Tektronix file driver, encode coordinate pair C+ SUBROUTINE GRTF04(LASTI, LASTJ, I0, J0, TKBUF, NW) INTEGER LASTI, LASTJ, I0, J0, NW BYTE TKBUF(*) C C Assume cursor is at position LASTI, LASTJ and that the light or C dark vector condition has been correctly set. Add up to 5 characters C to TKBUF to draw a vector to I0, J0. The minimum number of characters C are encoded to obtain the motion. C C 1995-Mar-17 - Created from GRTT04 - [DRC] C----------------------------------------------------------------------- INTEGER MASKLX, MASKHX PARAMETER (MASKLX = 64, MASKHX = 32) INTEGER MASKLY, MASKHY PARAMETER (MASKLY = 96, MASKHY = 32) INTEGER MASKEX PARAMETER (MASKEX=96) C INTEGER IEX, ILOX, IHIX, ILOY, IHIY INTEGER LEX, LLOX, LHIX, LLOY, LHIY C LHIY = LASTJ/128 LLOY = MOD(LASTJ/4, 32) LHIX = LASTI/128 LLOX = MOD(LASTI/4, 32) LEX = 4*MOD(LASTJ, 4) + MOD(LASTI, 4) IHIY = J0/128 ILOY = MOD(J0/4, 32) IHIX = I0/128 ILOX = MOD(I0/4, 32) IEX = 4*MOD(J0, 4) + MOD(I0, 4) C IF(IHIY.NE.LHIY) THEN NW=NW+1 TKBUF(NW) = 32+IHIY END IF IF(IEX.NE.LEX) THEN NW=NW+1 TKBUF(NW) = 96+IEX END IF IF(IEX.NE.LEX .OR. ILOY.NE.LLOY .OR. IHIX.NE.LHIX) THEN NW=NW+1 TKBUF(NW) = 96+ILOY END IF IF(IHIX.NE.LHIX) THEN NW=NW+1 TKBUF(NW) = 32+IHIX END IF NW=NW+1 TKBUF(NW) = 64+ILOX RETURN END , 2 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER, 3 RECL=256) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) IER = GRFMEM(BUFSIZ, BUFFER) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 pgplot/drivers/lxdriv.f010064400040640000322000000157710633714720200157060ustar00tjpcitmbr00000400000017C*LXDRIV -- PGPLOT driver for LaTeX Picture Environment C+ SUBROUTINE LXDRIV(OPCODE,RBUF,NBUF,CHR,LCHR) INTEGER OPCODE, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C Supported device: C This driver creates a text file containing commands for drawing C in the LaTeX picture environment, bracketted by \begin{picture} C and \end{picture}. The file can be included in a LaTeX document. C C If you have the option of including a PostScript file in your C LaTeX document, then that will usually give much better results C than using this driver, which has very limited capabilities. C C Device type code: C /LATEX C C Default file name: C pgplot.tex C C Default view surface dimensions: C The default picture size is 6 inches by 6 inches (which corresponds C to 1728x1728 units where a unit is 0.25pt = 1/288 inch). The picture C size can be changed by using PGPAP in the PGPLOT program. C C Resolution: C The driver rounds coordinates to multiples of 0.25pt (1/288 inch). C C Limitations: C The LaTeX picture environment has a very limited set of primitives. C In particular, diagonal lines must be composed out of dots. This C can lead to very large files. For some graphs (especially with a C lot of shaded areas), the capacity of many LaTeX systems can easily C be exceeded. C C Author: C Written by Grant McIntosh 95/02/14 (gmcint@relay.drev.dnd.ca). C C Revised by T. Pearson 95/06/19. C Revised to allow picture size to be adjusted by PGPAP: TJP 97/5/16. C----------------------------------------------------------------------- INTEGER LUN, IXO, IYO, IXPS, IYPS, I, J INTEGER INCR, NINC, IER, ISIGN, LENGTH, BX, BY, STATE INTEGER GROPTX REAL X1, Y1, X2, Y2, DELX, DELY, SLOPE CHARACTER*128 MSG CHARACTER*(*) DEVNAM PARAMETER (DEVNAM='LATEX (LaTeX picture environment)') CHARACTER*1 BS SAVE LUN, BS, BX, BY, STATE C----------------------------------------------------------------------- GOTO(10,20,30,40,50,60,70,80,90,100,110,120,130,140)OPCODE NBUF=-1 RETURN C----------------------------------------------------------------------- C--- IFUNC = 1, Return device name ------------------------------------- 10 CHR=DEVNAM LCHR=LEN(DEVNAM) BS=CHAR(92) RETURN C----------------------------------------------------------------------- C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- 20 RBUF(1)=0 RBUF(2)=32767 RBUF(3)=0 RBUF(4)=32767 RBUF(5)=0 RBUF(6)=1 NBUF=6 RETURN C----------------------------------------------------------------------- C--- IFUNC = 3, Return device resolution ------------------------------- 30 RBUF(1)=72./0.25 RBUF(2)=72./0.25 RBUF(3)=1. NBUF=3 RETURN C----------------------------------------------------------------------- C--- IFUNC = 4, Return misc device info -------------------------------- 40 CHR='HNNNNNNNNN' RETURN C----------------------------------------------------------------------- C--- IFUNC = 5, Return default file name ------------------------------- 50 CHR='pgplot.tex' LCHR=10 RETURN C----------------------------------------------------------------------- C--- IFUNC = 6, Return default physical size of plot ------------------- 60 RBUF(1)=0 RBUF(2)=BX RBUF(3)=0 RBUF(4)=BY NBUF=4 RETURN C----------------------------------------------------------------------- C--- IFUNC = 7, Return misc defaults ----------------------------------- 70 RBUF(1)=1 RETURN C----------------------------------------------------------------------- C--- IFUNC = 8, Select plot -------------------------------------------- 80 RETURN C----------------------------------------------------------------------- C--- IFUNC = 9, Open workstation --------------------------------------- 90 CONTINUE NBUF=2 C -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT LaTeX file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF CALL GRGLUN(LUN) IER = GROPTX(LUN, CHR(1:LCHR), 'pgplot.tex', 1) IF (IER.NE.0) THEN MSG = 'Cannot open output file for LaTeX picture: '// : CHR(:LCHR) CALL GRWARN(MSG) RBUF(1)=0 RBUF(2)=0 CALL GRFLUN(LUN) ELSE RBUF(2)=1 RBUF(1)=LUN STATE=1 BX=1728 BY=1728 END IF RETURN C----------------------------------------------------------------------- C--- IFUNC=10, Close workstation --------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN(LUN) STATE=0 RETURN C----------------------------------------------------------------------- C--- IFUNC=11, Begin picture ------------------------------------------- 110 CONTINUE BX = NINT(RBUF(1)) BY = NINT(RBUF(2)) WRITE(LUN,'(A)') BS//'setlength{'//BS//'unitlength}{0.25pt}' WRITE(LUN,'(A)') BS//'linethickness{1pt}' WRITE(LUN,'(A,I6,A,I6,A)') : BS//'begin{picture}(',BX,',',BY,')(0,0)' RETURN C----------------------------------------------------------------------- C--- IFUNC=12, Draw line ----------------------------------------------- 120 X1=RBUF(1) Y1=RBUF(2) X2=RBUF(3) Y2=RBUF(4) IXO=X1 IYO=Y1 IXPS=X2 IYPS=Y2 C vertical lines IF(IXPS.EQ.IXO) THEN LENGTH=ABS(IYPS-IYO) ISIGN=1 IF(LENGTH.NE.0) ISIGN=(IYPS-IYO)/LENGTH WRITE(LUN,5000) BS,IXO,IYO,BS,ISIGN,LENGTH 5000 FORMAT(A1,'put(',I4,',',I4,'){',A1,'line(0,',I4,'){',I4,'}}') RETURN ENDIF C horizontal lines IF(IYPS.EQ.IYO) THEN LENGTH=ABS(IXPS-IXO) ISIGN=1 IF(LENGTH.NE.0) ISIGN=(IXPS-IXO)/LENGTH WRITE(LUN,5100) BS,IXO,IYO,BS,ISIGN,LENGTH 5100 FORMAT(A1,'put(',I4,',',I4,'){',A1,'line(',I4,',0){',I4,'}}') RETURN ENDIF C other lines SLOPE=FLOAT(IYPS-IYO)/FLOAT(IXPS-IXO) INCR=1 IF(IXPS.LT.IXO) INCR=-1 NINC=MAX(1,ABS(IXPS-IXO)) DELX=INCR DELY=SLOPE*INCR 125 CONTINUE IF(ABS(DELY).GT.1) THEN NINC=NINC*2 DELX=DELX/2. DELY=SLOPE*DELX GOTO 125 ENDIF WRITE(LUN,5200) BS,IXO,IYO,DELX,DELY,NINC,BS 5200 FORMAT(A1,'multiput(',I4,',',I4,')(',F8.3,',',F8.3,'){',I4, * '}{',A1,'circle*{1}}') RETURN C----------------------------------------------------------------------- C--- IFUNC=13, Draw dot ------------------------------------------------ 130 I=NINT(RBUF(1)) J=NINT(RBUF(2)) WRITE(LUN,5300) BS,I,J,BS 5300 FORMAT(A1,'put(',I4,',',I4,'){',A1,'circle*{1}}') RETURN C----------------------------------------------------------------------- C--- IFUNC=14, End picture --------------------------------------------- 140 WRITE(LUN,'(A)') BS//'end{picture}' RETURN C----------------------------------------------------------------------- END -------pgplot/drivers/todriv.f010064400040640000322000000271200641627124200156740ustar00tjpcitmbr00000400000017C*TODRIV -- PGPLOT Toshiba driver C+ SUBROUTINE TODRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Toshiba device. C----------------------------------------------------------------------- C Version 1.0 - 1987 Jun 11 - T. J. Pearson. C----------------------------------------------------------------------- C C Supported device: Toshiba "3-in-one" printer, model P351. C C Device type code: /TOSHIBA. C C Default device name: PGPLOT.TOPLOT. C C Default view surface dimensions: 10.5in (horizontal) by 8.0in C (vertical). C C Resolution: 180 pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 132 bytes, with C embedded carriage-control characters. A full-page plot occupies C 901 512-byte blocks. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='TOSHIBA (Toshiba P351 "3-in-one" printer)') PARAMETER (DEFNAM='PGPLOT.TOPLOT') BYTE FF PARAMETER (FF=12) C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER BITMAP, OUTREC C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 1889 RBUF(3) = 0 RBUF(4) = 1439 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 180.0 RBUF(2) = 180.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 1889 RBUF(3) = 0 RBUF(4) = 1439 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 3 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- dimensions of plot buffer BX = 1890 BY = 240 CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, STATUS='NEW', 2 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.EQ.1) IER = GRGMEM(4*BX+8, OUTREC) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER CLOSE (UNIT=UNIT, STATUS='DELETE') CALL GRFLUN(UNIT) END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, STATUS='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE NPICT = NPICT+1 C% type *,'Begin picture',NPICT IF (NPICT.GT.1) WRITE (UNIT=UNIT) FF CALL GRTO03(BX*BY, %val(BITMAP)) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE CALL GRTO01(1, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE CALL GRTO01(0, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT CALL GRTO02(UNIT, BX, BY, %val(BITMAP), 4*BX+8, %val(OUTREC)) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRTO01 -- PGPLOT Toshiba driver, draw line C+ SUBROUTINE GRTO01 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BX,BY) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:5) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'20'x,'10'x,'08'x,'04'x,'02'x,'01'x/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = NINT(D) IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO K=0,LENGTH KX = XP KY = (6*BY-1)-INT(YP) BITMAP(KX+1,KY/6+1) = BITMAP(KX+1,KY/6+1) .OR. 1 QMASK(MOD(KY,6)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K=0,LENGTH KX = XP KY = (6*BY-1)-INT(YP) BITMAP(KX+1,KY/6+1) = BITMAP(KX+1,KY/6+1) .AND. 1 (.NOT.QMASK(MOD(KY,6))) XP = XP + XINC YP = YP + YINC END DO END IF END C*GRTO02 -- PGPLOT Toshiba driver, copy bitmap to output file C+ SUBROUTINE GRTO02 (UNIT, BX, BY, BITMAP, BUFSIZ, OUTREC) INTEGER UNIT, BX, BY, BUFSIZ BYTE BITMAP(BX,BY), OUTREC(BUFSIZ) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C BUFSIZ (input) dimension of OUTREC (at least 4*BX+8) C OUTREC (work) output buffer C C N.B. BX is the number of columns in the bitmap, and 6*BY is the C number of rows; the bitmap must have a multiple of 24 rows (24 rows C printed simultaneously by printhead), so BY must be a multiple of 4. C C The output consists of: C (1) an initialization string (INIT); this sets the vertical spacing C increment to 2/15 inch [ESC RS 8] and turns off automatic C bidirectional print [ESC >]; C (2) the bitmap, expressed as a series of image data transfer C commands [ESC ; ...]; C (3) a reset string (RESET); this resets vertical spacing [ESC RS 9] C and bidirectional printing [ESC <]. C----------------------------------------------------------------------- BYTE ESC, CR, LF, RS PARAMETER (ESC=27, CR=13, LF=10, RS=30) INTEGER I, J, K, I2 BYTE INIT(5), RESET(5) DATA INIT / ESC, RS, 8, ESC, '>' / DATA RESET / ESC, RS, 9, ESC, '<' / CHARACTER*4 D C C Check preconditions (internal check). C IF (MOD(BY,4).NE.0) CALL GRQUIT('Internal error 1 in TODRIVER') IF (4*BX+8.GT.BUFSIZ) CALL GRQUIT('Internal error 2 in TODRIVER') C C Write bitmap. C WRITE (UNIT=UNIT) INIT OUTREC(1) = ESC OUTREC(2) = ICHAR(';') WRITE (D, '(I4.4)') BX OUTREC(3) = ICHAR(D(1:1)) OUTREC(4) = ICHAR(D(2:2)) OUTREC(5) = ICHAR(D(3:3)) OUTREC(6) = ICHAR(D(4:4)) OUTREC(4*BX+7) = CR OUTREC(4*BX+8) = LF DO J=1,BY,4 K = 7 DO I=1,BX OUTREC(K) = BITMAP(I,J) OUTREC(K+1) = BITMAP(I,J+1) OUTREC(K+2) = BITMAP(I,J+2) OUTREC(K+3) = BITMAP(I,J+3) K = K+4 END DO DO I=1,BUFSIZ,132 I2 = MIN(I+131,BUFSIZ) WRITE (UNIT=UNIT) (OUTREC(K),K=I,I2) END DO END DO WRITE (UNIT=UNIT) RESET END C*GRTO03 -- initialize buffer C+ SUBROUTINE GRTO03 (BUFSIZ,BUFFER) C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL/'40'X/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END /' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.EQ.1) IER = GRGMEM(4*BX+8, OUTREC) IF (IER.NE.1) THEN pgplot/drivers/vadriv.f010064400040640000322000000306510641626664100156720ustar00tjpcitmbr00000400000017C*VADRIV -- PGPLOT Canon Printer driver (portrait mode) SUBROUTINE VADRIV(IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Canon Laser printer - portrait mode. C C Supported device: Canon LBP-8/A2 Laser printer. C Conforms to ISO646,2022,2375 and 6429 specifications. C VDM (graphics) conforms to proposed American National C Standard VDM mode. C C Device type code: /VCAnon (Portrait mode only). C C Default file name: PGPLOT.CAN C C Default view surface dimensions: 19 by 24 cm. C C Resolution: 300 pixels per inch in both directions. C C Color capability: Color indices 0 (erase) and 1 (black) are C supported. Note, hardware polygon fill is used and colors C 0-11 control the fill pattern. C C Input capability: None. C C File format: Variable length records with Carriage control C of LIST. C C Obtaining hardcopy: If printer is connected to a terminal C line (RS-232 option) then printing the file on the corresponding C queue should suffice. If the printer is connected using C the Centronics interface, which appears the to VAX as an C LP device, then it is important to ensure that (1) all 8 bit C characters are passed to the printer (2) lines longer than C 132 bytes are not truncated, and (3) no extra formatting C commands (e.g. form-feeds) are sent to the printer. C This can be done with the VMS command: C $ SET PRINT/PASSALL/LOWER/CR C Note, some interface boards have a option to append a carriage C return after a formfeed or LF character, it is suggested C that this be disabled. C The file should be printed with the /PASSALL qualifier i.e., C $ PRINT/PASSALL C Note, SET PRINT/PASSALL and PRINT/PASSALL do not do the C same things and hence PASSALL is required in both locations. C C 27-Jan-1988 - Version can be sent over BITNET (I hope) [AFT]. C 27-Sep-1986 - Add color index 0 (erase) [AFT]. C 5-Aug-1986 - [AFT]. C 13-Nov-1991 - [MCS] Having corrected unit scale factor to be one dot C instead of 0.8mm in GRVA03, changed viewport dimensions C to appear the same as before. C 14-Nov-1991 - [MCS] 11 colour indexes are already implemented as fill C patterns - however device info on this said there were C only 0 and 1 - corrected IFUNC 2 now reports 11 colours C 15-Nov-1991 - [MCS] Converted to portrait mode - /vcanon. C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='VCANON (Canon LBP-8/A2 Laser printer, portrait)') INTEGER IS2, IVESC PARAMETER (IS2=30, IVESC=125) C- The maximum physical size of the plot in units of 1/300 inch. INTEGER MXLEN, MXWID PARAMETER (MXLEN=2362, MXWID=3366) C- Default size of plot. INTEGER IDEFL, IDEFW PARAMETER (IDEFL=2244, IDEFW=2835) C CHARACTER CBUF*256 CHARACTER MSG*10 CHARACTER CDASH(5),CFILL(0:11) INTEGER I0, J0, I1, J1, IER INTEGER LUN, ICOL, NPTS, LBUF, LASX, LASY SAVE LUN, ICOL, NPTS, LBUF, LASX, LASY C--- C- Patterns defined with 2 and " appear the same on our Canon C- so only one is used. Pattern 0 causes the polygon not to C- be filled. Pattern ) erases interior of polygon is the C- last character in list as all colors > max are set to C- this pattern. DATA CFILL/')','1','(','''','&','%', : '$','2','#','!','0',')'/ DATA CDASH/'0','1','3','"','4'/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, : 110,120,130,140,150,160,900,180,190,200, : 210) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in CA device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR=TYPE LCHR=LEN(TYPE) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=MXLEN RBUF(3)=0 RBUF(4)=MXWID RBUF(5)=0 RBUF(6)=11 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=300.0 RBUF(2)=300.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- 40 CHR='HNNANNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='PGPLOT.CAN' LCHR=10 RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=IDEFL RBUF(3)=0 RBUF(4)=IDEFW RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 CALL GRGLUN (LUN) OPEN (UNIT=LUN, FILE=CHR(:LCHR), STATUS='NEW', : FORM='FORMATTED', : RECL=512, IOSTAT=IER) IF (IER.EQ.0) THEN RBUF(2)=1 ELSE RBUF(2) = IER ENDIF RBUF(1)=LUN RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN (LUN) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 CALL GRVA03(LUN,1) C C [MCS] - By default the Y-axis goes down the page - use the Picture C area command to reverse this. '(',X0,Y0,X1,Y1,IS2 C LBUF=1 CBUF(LBUF:LBUF)='(' CALL GRVA04(0,CBUF,LBUF) CALL GRVA04(0,CBUF,LBUF) CALL GRVA04(MXWID,CBUF,LBUF) CALL GRVA04(MXLEN,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) C- Use the origin transfer command to ensure that the picture is C- centered on the page. I0=(MXLEN-NINT(RBUF(1)))/2 J0=(MXWID-NINT(RBUF(2)))/2 CBUF(LBUF+1:LBUF+2)=CHAR(IVESC)//'"' LBUF=LBUF+2 CALL GRVA04(I0,CBUF,LBUF) CALL GRVA04(J0,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRVA01(LUN,I0,J0,I1,J1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRVA01(LUN,I0,J0,I0,J0) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 CALL GRVA03(LUN,2) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C- Save pen number (up to 11) for possible use in pattern interior. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),11)) RBUF(1)=MAX(0,MIN(ICOL,1)) IF(ICOL.EQ.0) THEN CBUF(1:4)=CHAR(IVESC)//'G2'//CHAR(IS2) ELSE CBUF(1:4)=CHAR(IVESC)//'G0'//CHAR(IS2) END IF WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C- Currently turned off, since pattern is reset at beginning of C- every new line segment. Note, if GRVA01 was modified to C- properly use polylines then dash pattern may work better. 190 CBUF(1:4)='E1'//CDASH(NINT(RBUF(1)))//CHAR(IS2) WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- 200 IF(NPTS.EQ.0) THEN NPTS=RBUF(1) CBUF(1:5)='I'//CFILL(ICOL)//'0'//CHAR(IS2)//'2' LBUF=5 LASX=0 LASY=0 ELSE NPTS=NPTS-1 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRVA04(I0-LASX,CBUF,LBUF) CALL GRVA04(J0-LASY,CBUF,LBUF) LASX=I0 LASY=J0 IF(NPTS.EQ.0) THEN LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) 11 FORMAT(A) LBUF=0 END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C- (not possible but can be called). 210 RETURN C----------------------------------------------------------------------- END C*GRVA01 -- PGPLOT Canon Printer driver, line segment SUBROUTINE GRVA01 (LUN,I0,J0,I1,J1) C----------------------------------------------------------------------- C Canon device driver support routine. Draws a line segment. C Current routine plots end line segment as a separate polyline. C This can be improved. C C I0,J0 I I The coordinate of the start point. C I1,J1 I I The coordinate of the end point. C C 26-JUN-86 - [AFT] C----------------------------------------------------------------------- INTEGER IS2 PARAMETER (IS2=30) INTEGER LUN, I0, J0, I1, J1 INTEGER LBUF, IX, IY CHARACTER CBUF*64 C--- CBUF(1:1)='1' LBUF=1 CALL GRVA04(I0,CBUF,LBUF) CALL GRVA04(J0,CBUF,LBUF) IX=I1-I0 IY=J1-J0 CALL GRVA04(IX,CBUF,LBUF) CALL GRVA04(IY,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(1:LBUF) 11 FORMAT(A) RETURN END C*GRVA03 -- PGPLOT Canon Printer driver, begin/end SUBROUTINE GRVA03(LUN,ICMD) C----------------------------------------------------------------------- C Canon device driver support routine. Outputs to LUN the string C that begins a new picture (ICMD=1) or ends the current picture (ICMD=2). C C- LUN I I Logical unit of output file. C- ICMD I I =1 to begin plot, =2 to terminate plot. C C 26-Jun-1986 - [AFT] C 18-Jan-1988 - Change close brace to CHAR(125) [AFT] C 13-Nov-1991 - [MCS, Jodrell Bank, England] Noticed aliasing when C modified PGGRAY stipple pattern to be sinusoidal. C Error traced to scale factor set at 0.8mm C instead of 1 dot => 1/300 = 0.84667mm corrected by C specifying scale factor in integral dots. C----------------------------------------------------------------------- INTEGER IESC, IS2 PARAMETER (IESC=27, IS2=30) INTEGER LUN,ICMD CHARACTER CBUF*32 C--- 11 FORMAT(A) C--- IF(ICMD.EQ.1) THEN C- Go to ISO mode (ignored if in ISO mode already), Hard reset, C- and then go to ISO again (in case dip switches set to Diablo). CBUF( 1: 4)=CHAR(IESC)//';'//CHAR(IESC)//'c' CBUF( 5: 6)=CHAR(IESC)//';' C- Enable full paint mode. CBUF( 7:10)=CHAR(155)//'2&z' C- Go to vector mode. CBUF(11:13)=CHAR(155)//'&'//CHAR(125) C- Begin picture CBUF(14:21)='#PGPLOT'//CHAR(IS2) C- Scaling mode 1 pixel, Begin picture body. CBUF(22:28)='!0#1'//CHAR(IS2)//'$'//CHAR(IS2) WRITE(LUN,11) CBUF(1:28) ELSE IF(ICMD.EQ.2) THEN C- End picture, Return to text (0,0) CBUF(1:7)='%'//CHAR(IS2)//CHAR(125)//'p00'//CHAR(IS2) WRITE(LUN,11) CBUF(1: 7) END IF RETURN END C*GRVA04 -- PGPLOT Canon Printer driver, convert integer SUBROUTINE GRVA04(NUM,CBUF,LBUF) C----------------------------------------------------------------------- C Canon device driver support routine. Converts an integer into C the form used by the Canon Laser printer. C C- NUM I I Integer to be converted. C- CBUF I/O C* Buffer string C- LBUF I/O I Number of characters used in CBUF. C C 26-Jun-86 - [AFT] C----------------------------------------------------------------------- CHARACTER CBUF*(*) INTEGER NUM, LBUF INTEGER ITMP, IS, IC CHARACTER CTMP*5 C--- ITMP=NUM C- Bit 4(=16) is set for positive numbers and clear for negative. IS=16 IF(ITMP.LT.0) THEN IS=0 ITMP=-ITMP END IF C- Bits 6+7(=64,128) clear and Bit 5(=32) set, flags that this C- is the last byte in the number. CTMP(5:5)=CHAR(32+IS+IAND(ITMP,15)) ITMP=ITMP/16 IC=1 IF(ITMP.EQ.0) THEN C- Numbers in the range -15 to +15 can be sent in one byte. CBUF(LBUF+1:LBUF+1)=CTMP(5:5) ELSE C- Larger numbers require more bytes and are recorded 6 bits C- per byte with bit 7=(128) clear and bit 6(=64) set. 150 CTMP(5-IC:5-IC)=CHAR(64+IAND(ITMP,63)) IC=IC+1 ITMP=ITMP/64 IF(ITMP.NE.0) GOTO 150 CBUF(LBUF+1:LBUF+IC)=CTMP(6-IC:5) END IF LBUF=LBUF+IC RETURN END pgplot/drivers/vbdriv.f010064400040640000322000000154660641626635200157010ustar00tjpcitmbr00000400000017 SUBROUTINE VBDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for Canon Laser printer. PORTRAIT MODE. C C Supported device: Canon LBP-8/A2 Laser printer. C Conforms to ISO646,2022,2375 and 6429 specifications. C VDM (graphics) conforms to proposed American National C Standard VDM mode. C C Device type code: /VBCanon (portrait mode only). C C Default file name: PGPLOT.CAN C C Default view surface dimensions: 24 cm by 19 cm. C C Resolution: 300 pixels per inch in both directions. C C Color capability: Color indices 0 (erase) and 1 (black) are C supported. Note, hardware polygon fill is used and colors C 0-11 control the fill pattern. C C Input capability: None. C C File format: Variable length records with Carriage control C of LIST. C C Obtaining hardcopy: If printer is connected to a terminal C line (RS-232 option) then printing the file on the corresponding C queue should suffice. If the printer is connected using C the Centronics interface, which appears the to VAX as an C LP device, then it is important to ensure that (1) all 8 bit C characters are passed to the printer (2) lines longer than C 132 bytes are not truncated, and (3) no extra formatting C commands (e.g. form-feeds) are sent to the printer. C This can be done with the VMS command: C $ SET PRINT/PASSALL/LOWER/CR C Note, some interface boards have a option to append a carriage C return after a formfeed or LF character, it is suggested C that this be disabled. C The file should be printed with the /PASSALL qualifier i.e., C $ PRINT/PASSALL C Note, SET PRINT/PASSALL and PRINT/PASSALL do not do the C same things and hence PASSALL is required in both locations. C C 27-Jan-1988 - Version can be sent over BITNET (I hope) [AFT]. C 27-Sep-1986 - Add color index 0 (erase) [AFT]. C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE= : 'VBCANON (Canon laser printer, bitmap mode, portrait)') INTEGER IS2, IVESC PARAMETER (IS2=30, IVESC=125) C- The maximum physical size of the plot in units of .08mm. INTEGER MXLEN, MXWID PARAMETER (MXLEN=2470, MXWID=3580) C- Default size of plot. INTEGER IDEFL, IDEFW PARAMETER (IDEFL=2375, IDEFW=3000) C INTEGER GRGE00 CHARACTER CBUF*256 CHARACTER MSG*10 CHARACTER CDASH(5),CFILL(0:11) INTEGER I0, J0, I1, J1 INTEGER LUN, ICOL, NPTS, LBUF, LASX, LASY, IMAXL, IMAXW SAVE LUN, ICOL, NPTS, LBUF, LASX, LASY, IMAXL, IMAXW C--- C- Patterns defined with 2 and " appear the same on our Canon C- so only one is used. Pattern 0 causes the polygon not to C- be filled. Pattern ) erases interior of polygon is the C- last character in list as all colors > max are set to C- this pattern. DATA CFILL/')','1','(','''','&','%', & '$','2','#','!','0',')'/ DATA CDASH/'0','1','3','"','4'/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,900,180,190,200, & 210) IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in CA device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC= 1, Return device name. ------------------------------------- 10 CHR=TYPE LCHR=LEN(TYPE) RETURN C C--- IFUNC= 2, Return Physical min and max for plot device. ------------ 20 RBUF(1)=0 RBUF(2)=MXLEN RBUF(3)=0 RBUF(4)=MXWID RBUF(5)=0 RBUF(6)=1 NBUF=6 RETURN C C--- IFUNC= 3, Return device resolution. ------------------------------- 30 RBUF(1)=300.0 RBUF(2)=300.0 RBUF(3)=1 NBUF=3 RETURN C C--- IFUNC= 4, Return misc device info. -------------------------------- 40 CHR='HNNANNNNNN' LCHR=10 RETURN C C--- IFUNC= 5, Return default file name. ------------------------------- 50 CHR='PGPLOT.CAN' LCHR=10 RETURN C C--- IFUNC= 6, Return default physical size of plot. ------------------- 60 RBUF(1)=0 RBUF(2)=IDEFL RBUF(3)=0 RBUF(4)=IDEFW RETURN C C--- IFUNC= 7, Return misc defaults. ----------------------------------- 70 RBUF(1)=1 NBUF=1 RETURN C C--- IFUNC= 8, Select plot. -------------------------------------------- 80 RETURN C C--- IFUNC= 9, Open workstation. --------------------------------------- 90 RBUF(2)=GRGE00('FFL',LUN,CHR,LCHR) RBUF(1)=LUN RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CLOSE(UNIT=LUN) CALL GRFLUN(LUN) RETURN C C--- IFUNC=11, Begin Picture. ------------------------------------------ 110 CALL GRCA03(LUN,1) C- Use the origin transfer command to ensure that the picture is C- centered on the page. IMAXW=NINT(RBUF(2)) I0=(MXWID-IMAXW)/2 IMAXL=NINT(RBUF(1)) J0=(MXLEN-IMAXL)/2 CBUF(1:2)=CHAR(IVESC)//'"' LBUF=2 CALL GRCA04(J0,CBUF,LBUF) CALL GRCA04(I0,CBUF,LBUF) LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- 120 I0=IMAXW-NINT(RBUF(2)) J0=NINT(RBUF(1)) I1=IMAXW-NINT(RBUF(4)) J1=NINT(RBUF(3)) CALL GRCA01(LUN,I0,J0,I1,J1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- 130 I0=IMAXW-NINT(RBUF(2)) J0=NINT(RBUF(1)) CALL GRCA01(LUN,I0,J0,I0,J0) RETURN C C--- IFUNC=14, End Picture. -------------------------------------------- 140 CALL GRCA03(LUN,2) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C- Save pen number (up to 11) for possible use in pattern interior. 150 ICOL=MAX(0,MIN(NINT(RBUF(1)),11)) RBUF(1)=MAX(0,MIN(ICOL,1)) IF(ICOL.EQ.0) THEN CBUF(1:4)=CHAR(IVESC)//'G2'//CHAR(IS2) ELSE CBUF(1:4)=CHAR(IVESC)//'G0'//CHAR(IS2) END IF WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- 160 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- 180 RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C- Currently turned off, since pattern is reset at beginning of C- every new line segment. Note, if GRCA01 was modified to C- properly use polylines then dash pattern may work better. 190 CBUF(1:4)='E1'//CDASH(NINT(RBUF(1)))//CHAR(IS2) WRITE(LUN,11) CBUF(:4) RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- 200 IF(NPTS.EQ.0) THEN NPTS=RBUF(1) CBUF(1:5)='I'//CFILL(ICOL)//'0'//CHAR(IS2)//'2' LBUF=5 LASX=0 LASY=0 ELSE NPTS=NPTS-1 I0=IMAXW-NINT(RBUF(2)) J0=NINT(RBUF(1)) CALL GRCA04(J0-LASY,CBUF,LBUF) CALL GRCA04(I0-LASX,CBUF,LBUF) LASX=I0 LASY=J0 IF(NPTS.EQ.0) THEN LBUF=LBUF+1 CBUF(LBUF:LBUF)=CHAR(IS2) WRITE(LUN,11) CBUF(:LBUF) 11 FORMAT(A) LBUF=0 END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C- (not possible but can be called). 210 RETURN C----------------------------------------------------------------------- END pgplot/drivers/x2driv.c010064400040640000322000000353710614145222100156000ustar00tjpcitmbr00000400000017/* This routine is the PGPLOT interface to the Figaro/PGPLOT display server. */ /* Sam Southard, Jr. */ /* Created: 19-Nov-1990 */ /* 12-Dec-1990 SNS/CIT Locking mechanism implemented. VMS changes merged in */ /* 15-Mar-1991 SNS/CIT OPCODES 1, 4, and 5 (device name, capabilities, and */ /* default file name) now returned without checking for */ /* the existance of the figaro display server. */ /* 2-Apr-1991 SNS/CIT Modified to offset values from current window height, */ /* not the maximum, to deal with the changed version of */ /* the server. If the user changes the window size */ /* while a program is running, he loses. Too bad. */ /* 6-Sep-1991 SNS/CIT Changes from SSL::TENNANT implemented */ /* 13-Sep-1991 SNS/CIT Added routine to get the window, so that routines */ /* can use both TVPCKG & PGPLOT at the same time */ /* 18-Sep-1991 SNS/CIT Modified so that PGPLOT and TVPCKG can both be run at */ /* the same time. */ /* 20-Sep-1991 SNS/CIT Commands no longer begin with TOK_. Buffer length */ /* no longer hard-coded in. */ /* 14-Feb-1992 SNS/CIT Now handles multiple pgdisps */ /* 26-Feb-1992 SNS/CIT Now handles the pixel primatives (opcode 26) and */ /* cursor position scaling (opcode 27) */ /* 7-Apr-1992 SNS/CIT Opcode 7 now returns without consulting the driver. */ /* Error flag now reset when opcode 9 (open) received. */ /* 9-Jul-1992 SNS/CIT SET_LG_SIZE now really takes the size (before it */ /* claimed to take the size, but actually took the */ /* maximum coordinate, which is one less). */ /* 27-Sep-1992 SNS/CIT SET_LG_CSCALE now takes ASCII strings */ /* 4-Nov-1992 SNS/CIT To underscore or not to underscore? That is the */ /* question (with no easy answer). */ /* 2-Dec-1992 TJP/CIT Buffer SET_LG_SCALE. */ /* 31-Mar-1994 TJP Update include files */ /* 30-Apr-1996 TJP Ignore opcode 8 (used to select active device); */ /* Refuse to open a second device. */ /* The system include files */ #include /* for atoi(), free(), malloc() */ #include /* for printf(), sprintf() */ #include /* for strlen(), strncpy() */ /* The X Window include files */ #include #include /* The program include files */ #include "commands.h" #ifdef VMS #include #endif /* * Allow x2driv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call x2driv() or x2driv_(). */ #ifdef PG_PPU #define X2DRIV x2driv_ #else #define X2DRIV x2driv #endif #define PGDRIVNAME "XDISP (pgdisp or figdisp server)" #define PGDEFNAME "0" /* the name of the driver */ #define DRIVCAPS "IXNATRPNNN" /* the PGPLOT device capabilities */ #define INCHTOMM 25.4 /* convert from inches to mm */ #define MAXINTENSE 65535.0 /* maximum intensity of an RGB value */ #ifdef VMS void x2driv(opcode,rbuf,nbuf,chrdsc,lchr) int *opcode; /* The specific PGPLOT function */ float *rbuf; /* the floating point values */ int *nbuf; /* number of floats in rbuf */ struct dsc$descriptor_s *chrdsc; /* VMS passes strings by descriptor */ int *lchr; /* number of used characters in chr */ { int chrlen=chrdsc->dsc$w_length; char *chr=chrdsc->dsc$a_pointer; #else void X2DRIV(opcode,rbuf,nbuf,chr,lchr,chrlen) int *opcode; /* The specific PGPLOT function */ float *rbuf; /* the floating point values */ int *nbuf; /* number of floats in rbuf */ char *chr; /* character data */ int *lchr; /* number of used characters in chr */ int chrlen; /* actual fortran length of chr */ { #endif static short *combuf=NULL; /* a buffer for commands */ static int combuflen; /* the length of the commands buffer */ static int nextshort=0; /* place to put the next short */ static int isopen=0; /* if the screen is open */ static int error=0; /* if an error occurred */ static int clear=1; /* if we should clear the screen */ static int maxx,maxy,maxcol; /* maximum x, y, and color */ static short *polypts; /* pointer to polygon fill points */ static int npolypts=0; /* the number of polygon points */ static int ptssofar; /* number of points so far */ static float xscale,yscale; /* x and y scales */ static char lockname[40]; /* the name of the locking atom */ static int wymax; /* the current y max of the window */ int itmp; /* a temporary integer */ int i; /* silly loop variable */ int min; /* the number of chars to write */ short *answer; /* the return from the display server */ int anslen; /* the length of the answer */ float ftmp; /* a temporary floating point number */ short *sptr; /* a pointer to a short */ char *cptr; char tmpstr[20]; /* some temporary strings for CSCALE */ char tmpstr2[20]; char tmpstr3[20]; char tmpstr4[20]; int len1,len2,len3,len4; void figdisp_sendcommand(); /* send a command buffer */ short *figdisp_getresponse(); /* get a response from the server */ void figdisp_closecomm(); /* close connection with the server */ int figdisp_opencomm(); /* open connection with the server */ int figdisp_maxbuflen(); itmp=0; switch(*opcode) { /* take care of the trivial cases without consulting X */ case 1: min=strlen(PGDRIVNAME); if (min > chrlen) min=chrlen; for (i=0 ; i < min ; ++i) chr[i]=PGDRIVNAME[i]; for ( ; i < chrlen ; ) chr[i++]=' '; *lchr = min; itmp=1; break; case 4: for (i=0 ; i < 10 ; ++i) chr[i]=DRIVCAPS[i]; *lchr = 10; itmp=1; break; case 5: min=strlen(PGDEFNAME); if (min > chrlen) min=chrlen; for (i=0 ; i < min ; ++i) chr[i]=PGDEFNAME[i]; for ( ; i < chrlen ; ) chr[i++]=' '; itmp=1; break; case 7: rbuf[0]=1.0; itmp=1; break; default: break; } if (itmp) return; /* reset the error flag if this is an open call */ if (*opcode == 9) error=0; /* if there's been an error just forget about it */ if (error) return; if (!isopen && *opcode != 9) { printf("Programming error: PGPLOT device not opened\n"); return; } switch(*opcode) { /* do the real work */ case 2: rbuf[0]=rbuf[2]=rbuf[4]=0.0; rbuf[1]=maxx; rbuf[3]=maxy; rbuf[5]=maxcol; break; case 3: rbuf[0]=xscale; rbuf[1]=yscale; rbuf[2]=1.0; break; case 6: /* make room for this command */ if (nextshort >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=LG_DEF_SIZE; /* This command requires immediate response */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; answer=figdisp_getresponse(&anslen); if (answer[0] != LG_DEF_SIZE || anslen != 5) { printf("The PGPLOT server is seriously confused!\n"); error=1; return; } for (i=0 ; i < 4 ; ++i) rbuf[i]=answer[i+1]; wymax=answer[4]; XFree((char *)answer); break; case 8: /* Select device: ignore */ break; case 19: case 23: printf("OOPS - unsupported call %d!\n",*opcode); break; case 18: break; case 9: if (isopen) { /* already open: report an error */ printf("A device of type /XDISP is already open\n"); rbuf[0] = 0.0; rbuf[1] = 0.0; break; } /* initialize link */ if (combuf==NULL) { if ((combuflen= figdisp_maxbuflen()) < 0) { printf("Unable to get buffer size!\n"); error=1; return; } if ((combuf= (short *)malloc(combuflen*sizeof(short))) == NULL) { printf("Unable to get command buffer!\n"); error=1; return; } } i=atoi(chr); if (!figdisp_opencomm(combuflen,i)) { error=1; return; } /* find out the server's stats */ if (nextshort >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=LG_MAX_DIM; /* This command requires immediate response */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; answer=figdisp_getresponse(&anslen); if (answer[0] != LG_MAX_DIM || anslen != 7) { printf("The PGPLOT server is seriously confused!\n"); error=1; return; } maxx=answer[2]; wymax=maxy=answer[4]; maxcol=answer[6]; XFree((char *)answer); combuf[nextshort++]=LG_SCALE; /* This command requires immediate response */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; answer=figdisp_getresponse(&anslen); if (answer[0] != LG_SCALE || anslen != 5) { printf("The PGPLOT server is seriously confused!\n"); error=1; return; } xscale=INCHTOMM*((float)answer[3])/answer[1]; yscale=INCHTOMM*((float)answer[4])/answer[2]; XFree((char *)answer); /* make room for this command */ if (nextshort >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=LG_DEF_SIZE; /* This command requires immediate response */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; answer=figdisp_getresponse(&anslen); if (answer[0] != LG_DEF_SIZE || anslen != 5) { printf("The PGPLOT server is seriously confused!\n"); error=1; return; } wymax=answer[4]; XFree((char *)answer); isopen=1; if (nextshort+2 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=SHOW_LG_WIN; combuf[nextshort++]=1; combuf[nextshort++]=RESET; rbuf[0]=1.0; rbuf[1]=1.0; if (rbuf[2] != 0.0) clear=0; else clear=1; break; case 10: /* terminte communications with the server */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; figdisp_closecomm(); isopen=0; break; case 11: /* make room for this command */ if (nextshort+2 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=SET_LG_SIZE; combuf[nextshort++]=rbuf[0]+1; wymax=combuf[nextshort++]=rbuf[1]+1; --wymax; if (clear) { if (nextshort >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=CLR_LG_WIN; } break; case 12: /* make room for this command */ if (nextshort+4 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=DRAW_LINE; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=wymax-rbuf[1]; combuf[nextshort++]=rbuf[2]; combuf[nextshort++]=wymax-rbuf[3]; break; case 13: /* make room for this command */ if (nextshort+2 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=DRAW_DOT; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=wymax-rbuf[1]; break; case 14: /* make room for this command */ if (rbuf[0] != 1.0) { if (nextshort >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=CLR_LG_WIN; } break; case 15: /* make room for this command */ if (nextshort+1 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=SET_LG_COL; combuf[nextshort++]=rbuf[0]; break; case 16: figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; break; case 17: /* make room for this command */ if (nextshort+2 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=LG_CURS; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=wymax-rbuf[1]; /* This command requires immediate response */ figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; answer=figdisp_getresponse(&anslen); if (answer[0] != LG_CURS || anslen != 4) { printf("The PGPLOT server is seriously confused!\n"); error=1; return; } rbuf[0]=answer[1]; rbuf[1]=wymax-answer[2]; if (answer[3] & 0xFF00) { /* it was a button press */ switch(answer[3] & 0xFF) { case 0: chr[0]='A'; break; case 1: chr[0]='D'; break; default: chr[0]='X'; break; } } else chr[0]=answer[3] & 0xFF; XFree((char *)answer); break; case 20: /* is this the first call? */ if (!npolypts) { npolypts=rbuf[0]; if (npolypts*2+2 > combuflen) { printf("Too many polygon points!\n"); error=1; return; } if ((polypts=(short *)malloc( (unsigned)2*npolypts*sizeof(short))) == (short *)NULL) { printf("No memory for polygon points!\n"); error=1; return; } ptssofar=0; } else { polypts[ptssofar<<1]=rbuf[0]; polypts[(ptssofar<<1)+1]=wymax-rbuf[1]; if (++ptssofar == npolypts) { /* finished */ if (nextshort+1+(npolypts<<1) >= combuflen) { figdisp_sendcommand(&combuf[0], nextshort); nextshort=0; } combuf[nextshort++]=FILL_POLY; combuf[nextshort++]=npolypts; ptssofar <<= 1; for (i=0 ; i < ptssofar ; ) combuf[nextshort++]=polypts[i++]; free((char *)polypts); npolypts=0; } } break; case 21: if (nextshort+5 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=SET_LG_LUT; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=1; combuf[nextshort++]=rbuf[1]*MAXINTENSE; combuf[nextshort++]=rbuf[2]*MAXINTENSE; combuf[nextshort++]=rbuf[3]*MAXINTENSE; break; case 22: if (nextshort+1 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=LG_LINE_WID; combuf[nextshort++]=xscale*0.005*rbuf[0]; break; case 24: if (nextshort+4 >= combuflen) { figdisp_sendcommand(&combuf[0],nextshort); nextshort=0; } combuf[nextshort++]=FILL_RECT; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=wymax-rbuf[1]; combuf[nextshort++]=rbuf[2]; combuf[nextshort++]=wymax-rbuf[3]; break; case 26: if (nextshort+*nbuf+1 >= combuflen) { figdisp_sendcommand(&combuf[0], nextshort); nextshort=0; } combuf[nextshort++]=LG_PIXLINE; combuf[nextshort++]= *nbuf - 2; combuf[nextshort++]=rbuf[0]; combuf[nextshort++]=wymax-rbuf[1]; for (i=2 ; i < *nbuf ; ) combuf[nextshort++]=rbuf[i++]; break; case 27: sprintf(&tmpstr[0],"%e", rbuf[0]); sprintf(&tmpstr2[0],"%e", rbuf[1]); sprintf(&tmpstr3[0],"%e", rbuf[2]); sprintf(&tmpstr4[0],"%e", rbuf[3]); len1=strlen(&tmpstr[0]) + 1; len2=strlen(&tmpstr2[0]) + 1; len3=strlen(&tmpstr3[0]) + 1; len4=strlen(&tmpstr4[0]) + 1; /* make sure there's enough room in the buffer */ if (nextshort+(len1+len2+len3+len4+1)/2 >= combuflen) { figdisp_sendcommand(&combuf[0], nextshort); nextshort=0; } combuf[nextshort++]=SET_LG_CSCALE; cptr = (char *)&combuf[nextshort]; strncpy(cptr, &tmpstr[0], len1); strncpy(cptr+len1, &tmpstr2[0], len2); strncpy(cptr+len1+len2, &tmpstr3[0], len3); strncpy(cptr+len1+len2+len3, &tmpstr4[0], len4); nextshort += (len1+len2+len3+len4+1)/2; /* figdisp_sendcommand(&combuf[0], nextshort); */ /* nextshort=0; */ break; default: printf("Unknown PGPLOT OPCODE!\n"); error=1; break; } return; } pgplot/drivers/vtdriv.f010064400040640000322000000424070553572166000157150ustar00tjpcitmbr00000400000017C*VTDRIV -- PGPLOT Regis (VT125) driver C+ SUBROUTINE VTDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Regis devices. C C Version 1.1 - 1987 Aug 17 - add cursor (TJP). C Version 1.3 - 1988 Mar 23 - add rectangle fill. C Version 1.4 - 1991 Nov 6 - standardization (TJP). C Version 1.5 - 1993 May 26 - more standardization (TJP). C Version 1.6 - 1993 Jun 4 - add SAVE statements, use GRxTER routines (AFT) C C Supported devices: Digital Equipment Corporation VT125, VT240, or C VT241 terminal; other REGIS devices may also work. C C Device type code: /VT125. C C Default file name: TT:PGPLOT.VTPLOT. This usually means the C terminal you are logged in to (logical name TT), but the plot can be C sent to another terminal by giving the device name, eg, TTC0:/VT, or C it can be saved in a file by specifying a file name, eg, C CITSCR:[TJP]XPLOT/VT (in this case a disk name must be included as C part of the file name). C C Default view surface dimensions: Depends on monitor. C C Resolution: The default view surface is 768 (horizontal) x C 460 (vertical) pixels. On most Regis devices, the resolution is C degraded in the vertical direction giving only 230 distinguishable C raster lines. (There are actually 240 raster lines, but 10 are reserved C for a line of text.) C C Color capability: Color indices 0--3 are supported. By default, C color index 0 is black (the background color). Color indices 1--3 C are white, red, and green on color monitors, or white, dark grey, and C light grey on monochrome monitors. The color representation of all C the color indices can be changed, although only a finite number of C different colors can be obtained (see the manual for the terminal). C C Input capability: The graphics cursor is a blinking C diamond-crosshair. The user positions the cursor using the arrow keys C and PF1--PF4 keys on his keyboard [Note: NOT the keyboard of C the terminal on which he is plotting, if that is different.] C The arrow keys move the cursor in the appropriate direction; the size C of the step for each keystroke is controlled by the PF1--PF4 keys: PF1 C -> 1 pixel, PF2 -> 4 pixels, PF3 -> 16 pixels, PF4 -> 64 pixels. [The C VT240 terminal has a built-in capability to position the cursor, but C PGPLOT does not use this as it is not available on the VT125.] The C user indicates that the cursor has been positioned by typing any C character other than an arrow or PF1-PF4 key [control characters, eg, C control-C, and other special characters should be avoided, as they C may be intercepted by the operating system]. C C File format: A REGIS plot file is formatted in records of 80 C characters or less, and has no carriage-control attributes. The C records are grouped into ``buffers,'' each of which begins with C Pp to put the terminal into graphics mode and ends with \ C to put it back into text mode. The terminal is in graphics mode only C while a buffer is being transmitted, so a user's program can write to C the terminal at any time (in text mode) without worrying if it might C be in graphics mode. Everything between the escape sequences is C REGIS: see the VT125 or VT240 manual for an explanation. PGPLOT C attempts to minimize the number of characters in the REGIS commands, C but REGIS is not a very efficient format. It does have the great C advantage, though, that it can easily be examined with an editor. C The file may also contain characters outside the Pp ... \ C delimiters, eg, escape sequences to erase the text screen and home C the cursor. C C The following escape sequences are used: C C [2J Erase entire screen (text) C [H Move cursor to home position C Pp Enter REGIS graphics mode C \ Leave REGIS graphics mode C C PGPLOT uses a very limited subset of the REGIS commands supported C by the VT125 and VT240. The following list summarizes the REGIS C commands presently used. C C Initialization: the following standard commands are used to initialize C the device every time a new frame is started; most of these restore a C VT125 or VT240 to its default state, but the screen addressing mode is C nonstandard. C C ; resynchronize C W(R) replace mode writing C W(I3) color index 1 C W(F3) both bit planes C W(M1) unit multiplier C W(N0) negative off C W(P1) pattern 1 C W(P(M2)) pattern multiplier 2 C W(S0) shading off C S(E) erase screen C S(G1) select graphics plane [Rainbow REGIS] C S(A[0,479][767,0]) screen addressing, origin at bottom left C S(I0) background dark C S(S1) scale 1 C S(M0(L0)(AL0)) output map section 0 (black) C S(M1(L30)(AH120L50S100)) output map section 1 (red/dim grey) C S(M2(L59)(AH240L50S100)) output map section 2 (green/light grey) C S(M3(L100)(AL100)) output map section 3 (white) C C Drawing lines: the P and V commands are used with absolute C coordinates, relative coordinates, and pixel vectors. The (B) C S), (E), and (W) modifiers are not used. Coordinates C which do not change are omitted. C C P[x,y] move to position, eg P[499,0] C V[x,y] draw vector to position, eg C V[][767][,479][0][,0] C C Line attributes: the line style and line color attributes are C specified with W commands, eg C C W(P2) line style 2 C W(I2) intensity (color index) 2 C C and S commands are used to change the output map. The PGPLOT color C indices 0, 1, 2, 3 correspond to output map sections 0, 3, 1, 2. C C Obtaining hardcopy: A hardcopy of the plot can be obtained C using a printer attached to the VT125/VT240 terminal (see the C instruction manual for the terminal). A plot stored in disk file C can be displayed by issuing a TYPE command (eg, TYPE PGPLOT.VTPLOT) C on a VT125 or VT240. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='VT125 (DEC VT125 and other REGIS terminals)') PARAMETER (DEFNAM='PGPLOT.VTPLOT') C CHARACTER*(*) VTINIT PARAMETER (VTINIT=';W(RI3F3M1N0P1P(M2)S0)S(E)'// 1 'S(G1A[0,479][767,0]I0S1)'// 2 'S(M0(L0)(AL0))'// 3 'S(M3(L100)(AL100))'// 4 'S(M1(L30)(AH120L50S100))'// 5 'S(M2(L59)(AH240L50S100))') CHARACTER*(*) CURSOR, VTERAS, VTHOME PARAMETER (CURSOR='[24;1f') PARAMETER (VTERAS='[2J') PARAMETER (VTHOME='[H') INTEGER BUFSIZ PARAMETER (BUFSIZ=500) C INTEGER IER, I0, J0, I1, J1, L, LASTI, LASTJ, UNIT SAVE LASTI, LASTJ, UNIT INTEGER CI, NPTS, L1, L2, BUFLEV SAVE NPTS, BUFLEV INTEGER MONO, IR, IG, IB, ICH, ICX, ICY, LTMP INTEGER VTCODE(0:3) SAVE VTCODE INTEGER GROTER LOGICAL APPEND SAVE APPEND REAL CH, CL, CS CHARACTER*(BUFSIZ) BUFFER SAVE BUFFER CHARACTER*80 CTEMP CHARACTER*64 INSTR CHARACTER*20 INSTR1,INSTR2 CHARACTER*2 PIX(0:22) SAVE PIX DATA PIX /'V5','V4','V3',7*' ','V6',' ','V2',7*' ','V7', 1 'V0','V1'/ DATA VTCODE / 0, 3, 1, 2 / C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100,110,120, : 130,140,150,160,170,180,190,200,210,220,230,240), IFUNC 900 WRITE (CTEMP,901) IFUNC 901 FORMAT('VTDRIV: Unimplemented function:',I10) CALL GRWARN(CTEMP) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 767 RBUF(3) = 0 RBUF(4) = 479 RBUF(5) = 0 RBUF(6) = 3 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 100.0 RBUF(2) = 100.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area fill, C No thick lines, Rectangle fill) C 40 CHR = 'ICNNNRNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CALL GRTRML(CHR, LCHR) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 767 RBUF(3) = 0 RBUF(4) = 459 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE APPEND = RBUF(3).NE.0.0 RBUF(1) = UNIT IER = GROTER(CHR, LCHR) IF (IER.LT.0) THEN LTMP = MIN(LEN(CTEMP), 34+LCHR) CTEMP = 'Unable to access graphics device: '//CHR(:LCHR) CALL GRWARN(CTEMP(1:LTMP)) RBUF(2) = 0 ELSE UNIT = IER RBUF(1) = IER RBUF(2) = 1 NBUF = 2 END IF BUFLEV = 0 LASTI = -1 LASTJ = -1 NPTS = 0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE C -- reposition cursor LTMP = 1 + LEN(CURSOR) CALL GRWTER(UNIT, CHAR(27)//CURSOR, LTMP) CALL GRCTER(UNIT) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C -- erase alpha screen and home cursor LTMP = 2 + LEN(VTERAS) + LEN(VTHOME) CALL GRWTER(UNIT, CHAR(27)//VTERAS//CHAR(27)//VTHOME, LTMP) C -- erase and initialize graphics screen IF (.NOT.APPEND) CALL GRVT02(VTINIT, BUFFER, BUFLEV, UNIT) RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.NE.LASTI .OR. J0.NE.LASTJ) THEN CALL GRFAO('P[#,#]',L,INSTR,I0,J0,0,0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) CALL GRVT02('V[]', BUFFER, BUFLEV, UNIT) END IF IF (I1.EQ.I0 .AND. J1.EQ.J0) THEN CONTINUE ELSE IF (ABS(I1-I0).LE.1 .AND. ABS(J1-J0).LE.1) THEN L = 10*(I1-I0+1) + (J1-J0+1) CALL GRVT02(PIX(L), BUFFER, BUFLEV, UNIT) ELSE IF (I1.EQ.I0) THEN INSTR1 = 'V[' L1 = 2 ELSE IF (ABS(I1-I0).GE.100) THEN CALL GRFAO('V[#',L1,INSTR1,I1,0,0,0) ELSE IF (I1.GT.I0) THEN CALL GRFAO('V[+#',L1,INSTR1,I1-I0,0,0,0) ELSE CALL GRFAO('V[#',L1,INSTR1,I1-I0,0,0,0) END IF IF (J1.EQ.J0) THEN INSTR2 = ']' L2 = 1 ELSE IF (ABS(J1-J0).GE.100) THEN CALL GRFAO(',#]',L2,INSTR2,J1,0,0,0) ELSE IF (J1.GT.J0) THEN CALL GRFAO(',+#]',L2,INSTR2,J1-J0,0,0,0) ELSE CALL GRFAO(',#]',L2,INSTR2,J1-J0,0,0,0) END IF CALL GRVT02(INSTR1(1:L1)//INSTR2(1:L2), 1 BUFFER, BUFLEV, UNIT) END IF LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) IF (I1.NE.LASTI .OR. J1.NE.LASTJ) THEN CALL GRFAO('P[#,#]V[]',L,INSTR,I1,J1,0,0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) END IF LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE C -- flush CALL GRVT03(BUFFER, UNIT, BUFLEV) C -- home cursor LTMP = 1 + LEN(VTHOME) CALL GRWTER(UNIT, CHAR(27)//VTHOME, LTMP) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) IF (CI.GT.3 .OR. CI.LT.0) CI = 1 CALL GRFAO('W(I#)',L,INSTR,VTCODE(CI),0,0,0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) LASTI = -1 RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE C -- flush buffer CALL GRVT03(BUFFER, UNIT, BUFLEV) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE C -- flush buffer CALL GRVT03(BUFFER, UNIT, BUFLEV) ICX = NINT(RBUF(1)) ICY = NINT(RBUF(2)) 171 ICX = MAX(0,MIN(767,ICX)) ICY = MAX(0,MIN(459,ICY)) C -- position graphics cursor WRITE (INSTR,111) CHAR(27),ICX,ICY 111 FORMAT(A,'PpP[', I4 ,',', I4 ,']') LTMP = 15 CALL GRWTER(UNIT, INSTR, LTMP) CALL GRGETC(ICH) C IF (ICH.LT.0) THEN CALL GRMCUR(ICH, ICX, ICY) GOTO 171 END IF C -- back to text mode CALL GRWTER(UNIT,CHAR(27)//CHAR(92),2) RBUF(1) = ICX RBUF(2) = ICY CHR = CHAR(ICH) LASTI = -1 NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE C -- flush CALL GRVT03(BUFFER, UNIT, BUFLEV) C -- erase alpha screen and home cursor LTMP = 2 + LEN(VTERAS) + LEN(VTHOME) CALL GRWTER(UNIT, CHAR(27)//VTERAS//CHAR(27)//VTHOME, LTMP) RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE CI = RBUF(1) MONO = NINT(30.*RBUF(2) + 59.*RBUF(3) + 11.*RBUF(4)) C -- convertRGB to hue, lightness, saturation CALL GRXHLS(RBUF(2),RBUF(3),RBUF(4),CH,CL,CS) IR = NINT(CH) IG = NINT(100.*CL) IB = NINT(100.*CS) CALL GRFAO('S(M#(L#)',L,INSTR, VTCODE(CI), MONO, 0, 0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) CALL GRFAO('(AH#L#S#))',L,INSTR, IR, IG, IB, 0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE C -- flush CALL GRVT03(BUFFER, UNIT, BUFLEV) C -- write string CALL GRWTER(UNIT, CHR, LCHR) LASTI = -1 RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) C -- move to top left and turn shading on CALL GRFAO('W(S1[,#])P[#,#]V[]', L, INSTR, J0, I0, J1, 0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) C -- draw to top right and turn shading off CALL GRFAO('V[#,#]W(S0)', L, INSTR, I1, J1, 0, 0) CALL GRVT02(INSTR(1:L), BUFFER, BUFLEV, UNIT) LASTI = -1 RETURN C----------------------------------------------------------------------- END C*GRVT02 -- PGPLOT Regis (VT125) driver, transfer data to buffer C+ SUBROUTINE GRVT02 (INSTR, BUFFER, HWM, UNIT) INTEGER HWM, UNIT CHARACTER*(*) INSTR, BUFFER C C Arguments: C INSTR (input) : text of instruction (bytes). C BUFFER (in/out) : output buffer. C HWM (in/out) : number of bytes used in BUFFER. C UNIT (input) : channel number for output (when buffer is full). C C Subroutines called: C GRVT03 C----------------------------------------------------------------------- INTEGER BUFSIZ, N C----------------------------------------------------------------------- BUFSIZ = LEN(BUFFER) N = LEN(INSTR) IF (HWM+N.GE.BUFSIZ) CALL GRVT03(BUFFER, UNIT, HWM) BUFFER(HWM+1:HWM+N) = INSTR(1:N) HWM = HWM+N C----------------------------------------------------------------------- END C*GRVT03 -- PGPLOT Regis (VT125) driver, copy buffer to device C+ SUBROUTINE GRVT03 (BUFFER, UNIT, N) CHARACTER*(*) BUFFER INTEGER UNIT, N C C Arguments: C BUFFER (input) address of buffer to be output C UNIT (input) channel number for output C N (input) number of bytes to transfer C (output) set to zero C----------------------------------------------------------------------- C Note: CHAR(27) = escape, CHAR(92) = backslash. C----------------------------------------------------------------------- INTEGER LTMP C--- IF (N.GE.1) THEN LTMP = 3 CALL GRWTER(UNIT, CHAR(27)//'Pp', LTMP) CALL GRWTER(UNIT, BUFFER, N) LTMP = 2 CALL GRWTER(UNIT, CHAR(27)//CHAR(92), LTMP) END IF N = 0 C----------------------------------------------------------------------- END N(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 767 RBUF(3) = 0 RBUF(4) = 479 pgplot/drivers/wsdriv.f010064400040640000322000000642560563172173000157160ustar00tjpcitmbr00000400000017C*WSDRIV -- PGPLOT driver for VAX workstations running VWS software C+ SUBROUTINE WSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for VAX workstations. C C Version 1.0 - 1988 Feb 3 - T. J. Pearson (after an original by C John Biretta). C C Version 1.1 - 1988 Mar 14 - S. C. Allendorf C Make work for 4 plane devices and some C other minor changes/bugs. C C Version 1.1001 - 1988 Mar 17 - S. L. Morris C Number of color entries corrected for 8 C plane system. C C Version 1.2 - 1988 Mar 18 - S. C. Allendorf C Change PAUSE to LIB$GET_COMMAND and change C cursor routines. C C Version 2.0 - 1988 Mar 23 - S. C. Allendorf C Add hardware area and rectangle fills C (OPCODE = 24). General cleanup. C C Version 3.0 - 1988 Apr 1 - S. C. Allendorf C Use absolute device coordinates and add C keypad cursor control. C C Version 3.1 - 1988 Nov 24 - S. C. Allendorf C Change cursor so that it can be seen C against all choices of background colors. C C Version 3.2 - 1989 Jan 6 - S. C. Allendorf C Disable display list entries to gain a C little more speed (30% in a test program). C C Version 3.3 - 1989 Jan 8 - S. C. Allendorf C Remove all magic numbers from the code and C query the hardware to get them. C C Version 4.0 - 1989 Apr 5 - S. C. Allendorf C Add support for line of pixels and correct C error in device selection support. C C Version 4.1 - 1989 Jun 07 - S. C. Allendorf C Fix varying resolution support and other C minor changes. General cleanup. C C Version 4.2 - 1990 May 30 - S. C. Allendorf C Fix cursor routine to function properly C in a workstation environment. C C Version 4.3 - 1993 Apr 23 - T. J. Pearson C This driver crashes when used with UISX. C Changed so that it only crashes if the C caller tries to use it. C======================================================================= C C Supported device: This driver should work with all VAX/VMS C workstations running VWS software; it requires the UISSHR C shareable image provided by DEC. C C Device type code: /WS. C C Default device name: PGPLOT. Output is always directed to device C SYS$WORKSTATION; the "device name" provided by the user is used to C label the PGPLOT window. C C Default view surface dimensions: Depends on monitor. C C Resolution: Depends on monitor. C C Color capability: VAX workstations can have 1, 4, or 8 bitplanes. C On 1-plane devices, there are only two colors (background = white, C color index 1 = black). On 4-plane devices, color indices 0-11 C are available (4 indices are reserved for text windows and pointers). C On 8-plane systems, color indices 0-249 are available (6 indices C are reserved for text windows and pointers). C C Input capability: The cursor is controlled by the mouse or the keypad C available on the controlling (DEC-like) keyboard. The user positions C the cursor, and then types any key on the controlling keyboard. C C File format: It is not possible (at present) to send workstation C plots to a disk file. C C Obtaining hardcopy: Not possible (at present). C----------------------------------------------------------------------- C C PGPLOT can be used in three modes on VAX Workstations. C C (1) Tektronix emulation. If you run a process in a Tektronix emulation C window, you can use device specification "/TEK" to tell PGPLOT to C plot in Tektronix mode within the same window. If you run in a VT220 C window, you can tell PGPLOT to create a new Tektronix window and plot C in it by giving a device specification "TK:/TEK". (TK: is the VMS C device name of the Tektronix emulator.) This has one problem: the C window will be deleted as soon as your program calls PGEND or exits; C you may need to add a user-prompt in your program before the call of C PGEND. C C (2) UIS mode. In UIS mode, PGPLOT calls the UIS subroutines for C creating graphics on the workstation. This has some advantages over C Tektronix emulation; e.g., it is faster, can use colors, and can C erase. The number of colors available depends on the VAXstation C model. Use device specification "/WS" to tell PGPLOT to create a new C window and plot using UIS calls. Again, the window is deleted on C program exit. PGPLOT executes a LIB$GET_COMMAND statement before C exiting, however, so that you can view the picture before it C disappears. Type at the prompt when you are ready to C continue. This also makes it impossible to overlay a plot created by C one program on a plot created by another. (The /APPEND qualifier C which allows this for other devices has no effect on device /WS.) C PGPLOT uses a window which is nominally 11 inches wide by 8.5 inches C tall, i.e., the same size as you would get in a hardcopy. If you C prefer a vertical orientation, execute the following command before C running the program: C C $ DEFINE PGPLOT_WS_ASPECT PORTRAIT C C Substitute LANDSCAPE for PORTRAIT to revert to horizontal C orientation. C C The PGPLOT cursor is controlled by the mouse or the keypad on the C controlling keyboard. Type any keyboard key to notify PGPLOT when you C have positioned the cursor. The mouse buttons are ignored (at C present). C C (3) DECWindows mode. In DECWindows mode, PGPLOT calls the XLIB C functions for creating graphics on the workstation. C----------------------------------------------------------------------- LOGICAL CHEAP, INIT, LANDSCAPE, MONO BYTE KBYTE, PIXEL(1024) INTEGER*2 CROSS(32), KWORD INTEGER*4 HEIGHT, IC, ICH, IER, IMAX, IMIN, I0, I1, JMAX, JMIN INTEGER*4 J0, J1, KBID, L, GRFMEM, GRGMEM, LMESS, MAXCOL INTEGER*4 NPTS, REMCAL, RESCOL, SMG$CREATE_VIRTUAL_KEYBOARD INTEGER*4 SMG$DELETE_VIRTUAL_KEYBOARD, SMG$READ_KEYSTROKE INTEGER*4 SMG$SET_KEYPAD_MODE, STEP, UISDC$SET_POINTER_POSITION INTEGER*4 UIS$CREATE_COLOR_MAP, UIS$CREATE_DISPLAY INTEGER*4 UIS$CREATE_WINDOW, UIS$PRESENT, VCMID, VDID, WDID INTEGER*4 WIDTH, XBUF, YBUF REAL*4 CTABLE(3, 16), PIXEL_X, PIXEL_Y, RESOL(2), SCALE, XHGHT REAL*4 XWDTH CHARACTER ASPECT*20, MESS*4, MSG*10, NAME*3 EQUIVALENCE (KBYTE, KWORD) DATA NAME /'WS '/ DATA INIT, STEP /.TRUE., 4/ C Set up the cursor bitmap DATA CROSS /6 * 256, 256, 65534, 256, 6 * 256, 0, + 6 * 256, 0, 64638, 0, 6 * 256, 0/ C Initialize the color table DATA CTABLE /0.0,0.0,0.0, 1.0,1.0,1.0, 1.0,0.0,0.0, 0.0,1.0,0.0, 1 0.0,0.0,1.0, 0.0,1.0,1.0, 1.0,0.0,1.0, 1.0,1.0,0.0, 2 1.0,0.5,0.0, 0.5,1.0,0.0, 0.0,1.0,0.5, 0.0,0.5,1.0, 3 0.5,0.0,1.0, 1.0,0.0,0.5, 0.333,0.333,0.333, 5 0.667,0.667,0.667/ C These avoid using the includes PARAMETER PATT$C_FOREGROUND = 2 PARAMETER SMG$K_TRM_PF1 = 256 PARAMETER SMG$K_TRM_PF2 = 257 PARAMETER SMG$K_TRM_PF3 = 258 PARAMETER SMG$K_TRM_PF4 = 259 PARAMETER SMG$K_TRM_KP1 = 261 PARAMETER SMG$K_TRM_KP2 = 262 PARAMETER SMG$K_TRM_KP3 = 263 PARAMETER SMG$K_TRM_KP4 = 264 PARAMETER SMG$K_TRM_KP5 = 265 PARAMETER SMG$K_TRM_KP6 = 266 PARAMETER SMG$K_TRM_KP7 = 267 PARAMETER SMG$K_TRM_KP8 = 268 PARAMETER SMG$K_TRM_KP9 = 269 PARAMETER SMG$K_TRM_UP = 274 PARAMETER SMG$K_TRM_DOWN = 275 PARAMETER SMG$K_TRM_LEFT = 276 PARAMETER SMG$K_TRM_RIGHT = 277 PARAMETER SS$_NORMAL = 1 PARAMETER UIS$C_MODE_COPY = 2 C----------------------------------------------------------------------- C On first call, find out what C sort of workstation we have. C IF (INIT .AND. IFUNC.NE.1) THEN INIT = .FALSE. C Check for the UIS library. IER = UIS$PRESENT () C Only do the following if we C actually have a UIS workstation. IF (IER .EQ. SS$_NORMAL) THEN C Get the number of planes. C NOTE: This may only work for C monochrome and color displays. C The code may not work for C intensity displays. CALL UIS$GET_HW_COLOR_INFO ('SYS$WORKSTATION', , MAXCOL, 1 , , , , , , RESCOL) C Find the display resolution. CALL UIS$GET_DISPLAY_SIZE ('SYS$WORKSTATION', XWDTH, XHGHT, 1 PIXEL_X, PIXEL_Y) RESOL(1) = PIXEL_X * 2.54 RESOL(2) = PIXEL_Y * 2.54 C Calculate a scale factor to C handle display devices with C different resolutions. SCALE = 77.446785 / MAX (RESOL(1), RESOL(2)) C Calculate the size of the border C around the plot. IMIN = NINT (0.25 * RESOL(1) * SCALE) JMIN = NINT (0.25 * RESOL(2) * SCALE) C See what orientation we want. CALL GRGENV ('WS_ASPECT', ASPECT, L) IF (ASPECT(1:1) .EQ. 'P') THEN C Portrait mode (pixels). WIDTH = NINT (8.113636 * RESOL(1) * SCALE) HEIGHT = NINT (10.5 * RESOL(2) * SCALE) LANDSCAPE = .FALSE. ELSE C Landscape mode (pixels). WIDTH = NINT (11.0 * RESOL(1) * SCALE) HEIGHT = NINT (8.5 * RESOL(2) * SCALE) LANDSCAPE = .TRUE. END IF C Set the other border. IMAX = WIDTH - IMIN - 1 JMAX = HEIGHT - JMIN - 1 C Calculate the size of the window C in centimeters. XWDTH = FLOAT (WIDTH) / PIXEL_X XHGHT = FLOAT (HEIGHT) / PIXEL_Y ELSE C Deal with error on the open C workstation call. MAXCOL = 1 RESCOL = 0 END IF C Set the machine characteristics. IF (MAXCOL .EQ. 256) THEN NAME = 'WS8' MONO = .FALSE. CHEAP = .FALSE. ELSE IF (MAXCOL .EQ. 16) THEN NAME = 'WS4' MONO = .FALSE. CHEAP = .TRUE. ELSE IF (MAXCOL .EQ. 2) THEN NAME = 'WS1' MONO = .TRUE. CHEAP = .TRUE. ELSE NAME = 'WS0' MONO = .TRUE. CHEAP = .TRUE. END IF C Set maximum color index. MAXCOL = MAXCOL - RESCOL - 1 END IF C Branch on opcode. GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260), IFUNC 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in VAX/WS device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = NAME // ' (VAX UIS workstation)' LCHR = 27 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0.0 RBUF(2) = FLOAT (IMAX - IMIN) RBUF(3) = 0.0 RBUF(4) = FLOAT (JMAX - JMIN) RBUF(5) = 0.0 RBUF(6) = FLOAT (MAXCOL) NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = RESOL(1) RBUF(2) = RESOL(2) RBUF(3) = 1.0 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Interactive, Cursor, No dashed lines, Area fill, C No thick lines, Rectangle fill, Line of pixels.) C 40 CONTINUE IF (CHEAP) THEN CHR = 'ICNANRNNNN' ELSE CHR = 'ICNANRPNNN' END IF LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = 'PGPLOT' LCHR = 6 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0.0 RBUF(2) = FLOAT (IMAX - IMIN) RBUF(3) = 0.0 RBUF(4) = FLOAT (JMAX - JMIN) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1.0 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Return an error if UIS software C is missing. IER = UIS$PRESENT () IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRWARN ('UIS is not installed on this system.') RBUF(2) = IER RETURN END IF C Open device. First allocate a C color map. VCMID = UIS$CREATE_COLOR_MAP (MAXCOL + 1) C Create a display. VDID = UIS$CREATE_DISPLAY (0.0, 0.0, FLOAT (IMAX + IMIN), 1 FLOAT (JMAX + JMIN), XWDTH, XHGHT, VCMID) C Disable display list entries C (~30% speed improvement). CALL UIS$DISABLE_DISPLAY_LIST (VDID) C Open a window. WDID = UIS$CREATE_WINDOW (VDID, 'SYS$WORKSTATION', CHR(:LCHR), 1 0.0, 0.0, FLOAT (IMAX + IMIN), FLOAT (JMAX + JMIN), 2 XWDTH, XHGHT) C Initialize device. First C set the color registers. IF (MONO) THEN C Background (CI = 0) white, C write (CI = 1) in black CALL UIS$SET_COLOR (VDID, 0, 1.0, 1.0, 1.0) CALL UIS$SET_COLOR (VDID, 1, 0.0, 0.0, 0.0) ELSE C Define color indices 0-15; C background (CI = 0) black, C write (CI = 1) in white. DO 95 IC = 0, MIN (15, MAXCOL) CALL UIS$SET_COLOR (VDID, IC, CTABLE(1, IC + 1), 1 CTABLE(2, IC + 1), CTABLE(3, IC + 1)) 95 CONTINUE END IF C Set the background color. CALL UIS$SET_BACKGROUND_INDEX (VDID, 0, 1, 0) C For some reason, this does not C work on monochrome systems. IF (.NOT. MONO) THEN CALL UIS$SET_WRITING_MODE (VDID, 1, 1, UIS$C_MODE_COPY) END IF C Set the font for fill patterns. CALL UIS$SET_FONT (VDID, 1, 1, 'UIS$FILL_PATTERNS') C Successful-- return wd_id. RBUF(1) = WDID RBUF(2) = 1.0 NBUF = 2 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CALL GRGCOM (MESS, CHAR (7)//'Type to continue: ', LMESS) C Clean up resources. CALL UIS$DELETE_WINDOW (WDID) CALL UIS$DELETE_DISPLAY (VDID) CALL UIS$DELETE_COLOR_MAP (VCMID) C Reset the initialization C variable. INIT = .TRUE. RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C Clear the screen. CALL UISDC$ERASE (WDID) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN I1 = INT (RBUF(3) + 0.5) + IMIN J1 = INT (RBUF(4) + 0.5) + JMIN CALL UISDC$PLOT (WDID, 1, I0, J0, I1, J1) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN CALL UISDC$PLOT (WDID, 1, I0, J0) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) CALL UIS$SET_WRITING_INDEX (VDID, 1, 1, IC) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE C Create a virtual keyboard for C cursor control. IER = SMG$CREATE_VIRTUAL_KEYBOARD (KBID, 'SYS$COMMAND') IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to create a virtual keyboard.') END IF C Set the keyboard to keypad mode. IER = SMG$SET_KEYPAD_MODE (KBID, 1) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to set keypad mode.') END IF C Set cursor pattern to a cross. CALL UISDC$SET_POINTER_PATTERN (WDID, CROSS, 2, 8, 8, IMIN, JMIN, 1 IMAX, JMAX) C Convert input coordinates. I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN C Set cursor to correct spot (if C it is in the PGPLOT window). 175 IF (I0 .GE. IMIN .AND. I0 .LE. IMAX .AND. 1 J0 .GE. JMIN .AND. J0 .LE. JMAX) THEN CALL UIS$POP_VIEWPORT (WDID) IER = UISDC$SET_POINTER_POSITION (WDID, I0, J0) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to set the pointer position.') END IF END IF C Wait for a keystroke. IER = SMG$READ_KEYSTROKE (KBID, ICH) C Read cursor location (this C covers the case where the user C moved the cursor with the C mouse). CALL UISDC$GET_POINTER_POSITION (WDID, I0, J0) C Catch error returns. IF (IER .NE. SS$_NORMAL) ICH = 0 C Handle the keypad keys. IF (ICH .EQ. SMG$K_TRM_UP .OR. ICH .EQ. SMG$K_TRM_KP8) THEN J0 = MIN (JMAX, J0 + STEP) ELSE IF (ICH .EQ. SMG$K_TRM_DOWN .OR. ICH .EQ. SMG$K_TRM_KP2) THEN J0 = MAX (JMIN, J0 - STEP) ELSE IF (ICH .EQ. SMG$K_TRM_LEFT .OR. ICH .EQ. SMG$K_TRM_KP4) THEN I0 = MAX (IMIN, I0 - STEP) ELSE IF (ICH .EQ. SMG$K_TRM_RIGHT .OR. 1 ICH .EQ. SMG$K_TRM_KP6) THEN I0 = MIN (IMAX, I0 + STEP) ELSE IF (ICH .EQ. SMG$K_TRM_KP7) THEN I0 = MAX (IMIN, I0 - STEP) J0 = MIN (JMAX, J0 + STEP) ELSE IF (ICH .EQ. SMG$K_TRM_KP9) THEN I0 = MIN (IMAX, I0 + STEP) J0 = MIN (JMAX, J0 + STEP) ELSE IF (ICH .EQ. SMG$K_TRM_KP3) THEN I0 = MIN (IMAX, I0 + STEP) J0 = MAX (JMIN, J0 - STEP) ELSE IF (ICH .EQ. SMG$K_TRM_KP1) THEN I0 = MAX (IMIN, I0 - STEP) J0 = MAX (JMIN, J0 - STEP) ELSE IF (ICH .EQ. SMG$K_TRM_KP5) THEN I0 = WIDTH / 2 J0 = HEIGHT / 2 ELSE IF (ICH .EQ. SMG$K_TRM_PF1) THEN STEP = 1 ELSE IF (ICH .EQ. SMG$K_TRM_PF2) THEN STEP = 4 ELSE IF (ICH .EQ. SMG$K_TRM_PF3) THEN STEP = 16 ELSE IF (ICH .EQ. SMG$K_TRM_PF4) THEN STEP = 64 END IF C Toss out unacceptable C characters. IF (ICH .LT. 0 .OR. ICH .GT. 255) GOTO 175 C Make sure the pointer is in the C PGPLOT window. IF (I0 .LT. IMIN .OR. I0 .GT. IMAX) GOTO 175 IF (J0 .LT. JMIN .OR. J0 .GT. JMAX) GOTO 175 C Delete the virtual keyboard. IER = SMG$DELETE_VIRTUAL_KEYBOARD (KBID) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRWARN ('Failed to delete virtual keyboard.') END IF C Return the cursor to normal. CALL UISDC$SET_POINTER_PATTERN (WDID, , , , , IMIN, JMIN, 1 IMAX, JMAX) C Set the return values. CHR(1:1) = CHAR (ICH) RBUF(1) = FLOAT (I0 - IMIN) RBUF(2) = FLOAT (J0 - JMIN) NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (REMCAL .EQ. 0) THEN C First time, set number of points C in polygon and allocate the C memory for the arrays. NPTS = RBUF(1) REMCAL = NPTS IER = GRGMEM (4 * NPTS, XBUF) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate temporary buffer.') END IF IER = GRGMEM (4 * NPTS, YBUF) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate temporary buffer.') END IF ELSE C Second and succeeding calls, C change counter and load arrays. REMCAL = REMCAL - 1 I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN CALL GRWS00 (NPTS, %VAL (XBUF), %VAL (YBUF), REMCAL, I0, J0) C If last call, fill the area and C deallocate the memory. IF (REMCAL .EQ. 0) THEN CALL UIS$SET_FILL_PATTERN (VDID, 1, 1, PATT$C_FOREGROUND) CALL UISDC$PLOT_ARRAY (WDID, 1, NPTS, %VAL (XBUF), 1 %VAL (YBUF)) CALL UIS$SET_FILL_PATTERN (VDID, 1, 1) IER = GRFMEM (4 * NPTS, XBUF) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRWARN ('Failed to deallocate temporary buffer.') END IF IER = GRFMEM (4 * NPTS, YBUF) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRWARN ('Failed to deallocate temporary buffer.') END IF END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE C Ignore for a monochrome device. IF (.NOT. MONO) THEN IC = RBUF(1) CALL UIS$SET_COLOR (VDID, IC, RBUF(2), RBUF(3), RBUF(4)) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle Fill. ----------------------------------------- C 240 CONTINUE CALL UIS$SET_FILL_PATTERN (VDID, 1, 1, PATT$C_FOREGROUND) I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN I1 = INT (RBUF(3) + 0.5) + IMIN J1 = INT (RBUF(4) + 0.5) + JMIN CALL UISDC$PLOT (WDID, 1, I0, J0, I1, J0, I1, J1, I0, J1) CALL UIS$SET_FILL_PATTERN (VDID, 1, 1) RETURN C C--- IFUNC=25, --------------------------------------------------------- C (Not implemented: ignored) C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE IF (CHEAP) THEN GOTO 900 ELSE I0 = INT (RBUF(1) + 0.5) + IMIN J0 = INT (RBUF(2) + 0.5) + JMIN I1 = I0 + NBUF - 3 DO 265 IC = 1, NBUF - 2 KWORD = INT (RBUF(IC + 2) + 0.5) PIXEL(IC) = KBYTE 265 CONTINUE CALL UISDC$IMAGE (WDID, 1, I0, J0, I1, J0, 1 NBUF - 2, 1, 8, PIXEL) END IF RETURN C----------------------------------------------------------------------- END C*GRWS00 -- PGPLOT WS driver, load polygon arrays C+ SUBROUTINE GRWS00 (N0, XBUF, YBUF, N, X, Y) INTEGER N, N0, X, XBUF(N0), Y, YBUF(N0) C-- XBUF(N0 - N) = X YBUF(N0 - N) = Y RETURN END -------------------- C 100 CONTINUE CALL GRGCOM (MESS, CHAR (7)//'Type to continue: ', LMESS) C Clean up resources. CALL UIS$DELETE_WINDOW (WDID) CALL UIS$DELETE_DISPLAY (VDID) CALL UIS$DELETE_COLOR_MAP (VCMID) C Reset the initpgplot/drivers/xedriv.f010064400040640000322000001227300563172173700157000ustar00tjpcitmbr00000400000017C*XEDRIV -- PGPLOT driver for VAX workstations with DECWindows software C+ SUBROUTINE XEDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for VAX workstations running DECWindows. C C Version 1.0 - 1989 Apr 15 - S. C. Allendorf C Initial try (DWDRIVER.FOR). C Version 2.0 - 1990 Mar 25 - S. C. Allendorf C Merge functionality with Al Fey's C C version for XWindows (XWDRIVER.C). C Version 2.1 - 1990 Apr 03 - S. C. Allendorf C Add asynchronous event handler and add C code to implement a backing store. C Version 2.2 - 1990 Apr 05 - S. C. Allendorf C Modify so that only the necessary portion C of the display is redrawn when flushed and C when we receive an expose event. C Version 3.0 - 1990 Apr 15 - S. C. Allendorf C Merge functionality with WEW Jr.'s C XE driver (XEDRIVER.FOR). C Version 3.1 - 1990 Oct 5 - T. J. Pearson C Restore input focus after using cursor. C Report interactive, not hardcopy. C Version 3.2 - 1991 Dec 5 - T. J. Pearson C Change name from X11 to XWINDOW C======================================================================= C C Supported device: This driver should work with all VAX/VMS C workstations running the DECWindows software. C C Device type code: /XWINDOW. C C Default device name: PGPLOT. Output is always directed to device C DECW$DISPLAY; the "device name" provided by the user is used to label C the PGPLOT window. C C Default view surface dimensions: Depends on the monitor, but nominally C 10.5 inches horizontally by 8.0 inches vertically. If you prefer a C vertical orientation, execute the following command before running the C program: C C $ DEFINE PGPLOT_XWIN_ASPECT PORTRAIT C C Substitute LANDSCAPE for PORTRAIT to revert to a horizontal C orientation. C C Resolution: Nominally 75 dpi, but depends on the monitor. C C Color capability: This driver will use as many colors as the C DECWindows server will allow, up to a maximum of 145 colors. This C maximum comes from the maximum number of colors that PGPLOT will use C internally, and a desire to avoid hogging the resources of the server. C C Input capability: The cursor is controlled by the mouse. The user C positions the cursor, and then types any key on the controlling C keyboard. The buttons on the mouse are also defined to return the C following characters: C C Button Character C ------ --------- C 1 A C 2 D C >2 X C C File format: It is not possible to send workstation plots to a disk C file using PGPLOT, but this may be accomplished using the standard C X Windows utility xwd. The format of the resulting file is documented C in the X Windows documentation. C C Obtaining hardcopy: Not possible using PGPLOT, but may be achieved C using the standard X Windows utilities xwd and xpr or the Print Screen C menu in DECWindows. C C NOTE: There is a bug in the early versions of DECWindows that cause C the OPEN_DISPLAY call to sometimes abort the calling program. This may C happen if you have used SET DISPLAY to define a display using the C local transport mechanism and you do not have access to it. The C routine should return 0 in such a case, but does not currently. If C you are going to use the SET DISPLAY command, use /TRANSPORT = DECNET C instead of /TRANSPORT = LOCAL or make sure that you will be able to C write to the display. This means that someone must be logged into the C workstation display and must have security set to allow you to write C to it. This bug has existed in all versions of DECWindows up through C the version shipped with VMS 5.3-1. C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='XWINDOW (Xwindow display)') INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF' LOGICAL INIT, LANDSCAPE, LOPIX, MONO BYTE IMAGE(1280), KBYTE(2), XLOGO(128) INTEGER*2 JWORD(2), KWORD INTEGER*4 ARGS(4), BACK, BUFLEN, CMAP, CONTIG, CURS, DC$_TERM INTEGER*4 DEFX, DEFY, DEPTH, DEVCLASS, DISPLAY, DVI$_DEVCLASS INTEGER*4 FORE, GC, GCB, HEIGHT, I, IC, ICON, IER, IMAX, IMIN INTEGER*4 ISTAT, I0, I1, JLONG, JMAX, JMIN, J0, J1, KEYSYM, L INTEGER*4 GRFMEM, LIB$GETDVI, LIB$GET_COMMAND, GRGMEM INTEGER*4 LWIN, MAXCOL, MAXX, MAXY, NPTS, PARENT INTEGER*4 PIXELS(145), PIXMAP, PLANE_MASKS(145), POINTS, REMCAL INTEGER*4 SCREEN, SS$_NORMAL, WIDTH, WINDOW, XMAX, XMIN, XMM INTEGER*4 XOFF, XPIX, YMAX, YMIN, YMM, YOFF, YPIX INTEGER*4 FWINDOW, FREVERT REAL*4 CTABLE(3, 16), FACTOR, RESOL(2) CHARACTER ASPECT*20, BUFFER*10, ICON_NAME*13, MESS*4, MSG*3 CHARACTER WINNAME*80 RECORD /X$COLOR/ BLACK, COLOR, RED RECORD /X$EVENT/ REPORT RECORD /X$GC_VALUES/ VALUES RECORD /X$IMAGE/ XI RECORD /X$POINT/ POINT RECORD /X$SET_WIN_ATTRIBUTES/ SETWINATTR RECORD /X$SIZE_HINTS/ SIZE_HINTS RECORD /X$VISUAL/ VISUAL C Declare the asynchronous expose C event handler. EXTERNAL GRXE03 C Setup the arguments passed to C the asynchronous expose event C routine. EQUIVALENCE (DISPLAY, ARGS(1)) EQUIVALENCE (PIXMAP, ARGS(2)) EQUIVALENCE (WINDOW, ARGS(3)) EQUIVALENCE (GC, ARGS(4)) C We need these because FORTRAN C does not have unsigned types. EQUIVALENCE (JWORD(1), JLONG), (KBYTE(1), KWORD) C Define some parameters to avoid C having to use include files. PARAMETER (DC$_TERM = 66) PARAMETER (DVI$_DEVCLASS = 4) PARAMETER (SS$_NORMAL = 1) C Initialize a couple of things. DATA ICON_NAME, INIT /'PGPLOT Window', .TRUE./ C Define the PGPLOT color table. DATA CTABLE /0.0,0.0,0.0, 1.0,1.0,1.0, 1.0,0.0,0.0, 0.0,1.0,0.0, + 0.0,0.0,1.0, 0.0,1.0,1.0, 1.0,0.0,1.0, 1.0,1.0,0.0, + 1.0,0.5,0.0, 0.5,1.0,0.0, 0.0,1.0,0.5, 0.0,0.5,1.0, + 0.5,0.0,1.0, 1.0,0.0,0.5, 0.333,0.333,0.333, + 0.667,0.667,0.667/ C Define the X Windows logo. DATA XLOGO / -1, 0, 0, -64, -2, 1, 0, -64, -4, + 3, 0, 96, -8, 7, 0, 48, -8, 7, 0, + 24, -16, 15, 0, 12, -32, 31, 0, 6, -64, + 63, 0, 6, -64, 63, 0, 3, -128, 127, -128, + 1, 0, -1, -64, 0, 0, -2, 97, 0, 0, + -2, 49, 0, 0, -4, 51, 0, 0, -8, 27, + 0, 0, -16, 13, 0, 0, -16, 14, 0, 0, + 96, 31, 0, 0, -80, 63, 0, 0, -104, 127, + 0, 0, -104, 127, 0, 0, 12, -1, 0, 0, + 6, -2, 1, 0, 3, -4, 3, -128, 1, -4, + 3, -64, 0, -8, 7, -64, 0, -16, 15, 96, + 0, -32, 31, 48, 0, -32, 31, 24, 0, -64, + 63, 12, 0, -128, 127, 6, 0, 0, -1/ C----------------------------------------------------------------------- C On the first call, find out what C sort of workstation we have. IF (INIT) THEN INIT = .FALSE. C Attempt to open a DECWindows C display. See note above C about DECWindows bug. DISPLAY = X$OPEN_DISPLAY () C Only do the following if we C actually have a DECWindows C display. IF (DISPLAY .NE. 0) THEN C Get the default screen that is C associated with the display. SCREEN = X$DEFAULT_SCREEN (DISPLAY) C Find the root window. PARENT = X$ROOT_WINDOW (DISPLAY, SCREEN) C Get the number of planes. DEPTH = X$DISPLAY_PLANES (DISPLAY, SCREEN) C Get the visual type. CALL X$DEFAULT_VISUAL (DISPLAY, SCREEN, VISUAL) C Classify the display. MONO = (VISUAL.X$L_VISU_CLASS .EQ. X$C_STATIC_GRAY) .OR. + (VISUAL.X$L_VISU_CLASS .EQ. X$C_STATIC_COLOR) .OR. + (DEPTH .EQ. 1) C Get the size of the display. XPIX = X$DISPLAY_WIDTH (DISPLAY, SCREEN) YPIX = X$DISPLAY_HEIGHT (DISPLAY, SCREEN) XMM = X$DISPLAY_WIDTH_MM (DISPLAY, SCREEN) YMM = X$DISPLAY_HEIGHT_MM (DISPLAY, SCREEN) C Calculate the resolution of the C display. RESOL(1) = 25.4 * REAL (XPIX) / REAL (XMM) RESOL(2) = 25.4 * REAL (YPIX) / REAL (YMM) C Set the aspect ratio of the C window. FACTOR = 8.5 / 11.0 C See what orientation we want. CALL GRGENV ('XWIN_ASPECT', ASPECT, L) C Calculate the window size. IF (ASPECT(1:1) .EQ. 'P') THEN C Potrait mode (pixels). HEIGHT = 828 * YPIX / 1024 WIDTH = NINT (FACTOR * HEIGHT) LANDSCAPE = .FALSE. ELSE C Landscape mode (pixels). WIDTH = 828 * XPIX / 1024 HEIGHT = NINT (FACTOR * WIDTH) LANDSCAPE = .TRUE. END IF C Calculate the size of the border C around the plot. IMIN = NINT (0.25 * RESOL(1)) JMIN = NINT (0.25 * RESOL(2)) C Set the maximum coordinates. IMAX = WIDTH - IMIN - 1 JMAX = HEIGHT - JMIN - 1 C Define the maximum allowed plot C size. This is a bit of a hack C to handle extra things that the C window manager might do to the C window. MAXX = XPIX - 2 * IMIN - 10 MAXY = YPIX - 2 * JMIN - 30 C Define the default width and C height of the plot. DEFX = IMAX - IMIN DEFY = JMAX - JMIN C Center the window in the C display. XOFF = (XPIX - WIDTH) / 2 YOFF = (YPIX - HEIGHT) / 2 C Find the default colormap. CMAP = X$DEFAULT_COLORMAP (DISPLAY, SCREEN) C See if we will be able to use C the colors. IF (MONO) THEN C On static displays and C monochrome displays we will only C be able to use two colors. MAXCOL = 1 ELSE C Determine the maximum number of C colors available. Make sure we C only grab a reasonable number. MAXCOL = MIN (X$DISPLAY_CELLS (DISPLAY, SCREEN), 145) C Grab as many color cells as we C need (or X will allow us). DO I = MAXCOL, 2, -1 ISTAT = X$ALLOC_COLOR_CELLS (DISPLAY, CMAP, CONTIG, + PLANE_MASKS, 0, PIXELS, I) MAXCOL = I IF (ISTAT .EQ. 1) GOTO 5 END DO C Set the value of the maximum C color index. If we found two or C fewer colors, revert to C monochrome. C 5 MAXCOL = MAXCOL - 1 IF (MAXCOL .EQ. 1) MONO = .TRUE. END IF ELSE C Deal with the error on the open C workstation call. MAXCOL = 1 LANDSCAPE = .TRUE. END IF C Set the machine characteristics. LOPIX = .FALSE. IF (MAXCOL .GT. 33) LOPIX = .TRUE. END IF C Branch on opcode. GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, + 110,120,130,140,150,160,170,180,190,200, + 210,220,230,240,250,260), IFUNC C 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in DECWindows device driver:' + // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 RBUF(2) = REAL (MAXX) RBUF(3) = 0.0 RBUF(4) = REAL (MAXY) RBUF(5) = 0.0 RBUF(6) = REAL (MAXCOL) NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE RBUF(1) = RESOL(1) RBUF(2) = RESOL(2) RBUF(3) = 1.0 ! Device coordinates per pixel NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is No Hardcopy, Cursor, No dashed lines, Area fill, C No thick lines, Rectangle fill, and possibly Line of pixels.) C 40 CONTINUE IF (LOPIX) THEN CHR = 'ICNANRPNNN' ELSE CHR = 'ICNANRNNNN' END IF LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = 'PGPLOT' LCHR = 6 RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 RBUF(2) = REAL (DEFX) RBUF(3) = 0.0 RBUF(4) = REAL (DEFY) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE RBUF(1) = 1.0 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Return an error if the display C couldn't be opened. The display C should be set with the VMS SET C DISPLAY command. IF (DISPLAY .EQ. 0) THEN CALL GRWARN ('Cannot open the specified DECWindows display.') RBUF(2) = 0.0 RETURN END IF C Stash away the passed window C name for later use. WINNAME = CHR(:LCHR) LWIN = LCHR C Define the foreground and C background colors to be black C and white respectively. FORE = X$BLACK_PIXEL (DISPLAY, SCREEN) BACK = X$WHITE_PIXEL (DISPLAY, SCREEN) C Create a window in the display. WINDOW = X$CREATE_WINDOW (DISPLAY, PARENT, XOFF, YOFF, + WIDTH, HEIGHT, 0, DEPTH, X$C_INPUT_OUTPUT, + VISUAL, 0, SETWINATTR) C Load the PGPLOT palette. IF (.NOT. MONO) THEN C Define color indices 0-15; C background (CI = 0) black, C write (CI = 1) in white. DO I = 0, MIN (15, MAXCOL) COLOR.X$L_COLR_PIXEL = PIXELS(I + 1) JLONG = NINT (CTABLE (1, I + 1) * 65535.0) COLOR.X$W_COLR_RED = JWORD(1) JLONG = NINT (CTABLE (2, I + 1) * 65535.0) COLOR.X$W_COLR_GREEN = JWORD(1) JLONG = NINT (CTABLE (3, I + 1) * 65535.0) COLOR.X$W_COLR_BLUE = JWORD(1) COLOR.X$B_COLR_FLAGS = X$M_DO_RED .OR. + X$M_DO_GREEN .OR. X$M_DO_BLUE C Load our color table into the C color map. CALL X$STORE_COLOR (DISPLAY, CMAP, COLOR) END DO C Redefine the background and C foreground colors to point at C our definitions. BACK = PIXELS(1) FORE = PIXELS(2) C Get color structures for the C cursor colors. RED.X$L_COLR_PIXEL = PIXELS(3) BLACK.X$L_COLR_PIXEL = PIXELS(1) CALL X$QUERY_COLOR (DISPLAY, CMAP, BLACK) CALL X$QUERY_COLOR (DISPLAY, CMAP, RED) END IF C Set the window colors. CALL X$SET_WINDOW_BACKGROUND (DISPLAY, WINDOW, BACK) CALL X$SET_WINDOW_BORDER (DISPLAY, WINDOW, FORE) C Initialize size hint property C for the window manager. SIZE_HINTS.X$L_SZHN_FLAGS = X$M_P_POSITION .OR. X$M_P_SIZE .OR. + X$M_P_MIN_SIZE .OR. X$M_P_MAX_SIZE SIZE_HINTS.X$L_SZHN_X = XOFF SIZE_HINTS.X$L_SZHN_Y = YOFF SIZE_HINTS.X$L_SZHN_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_HEIGHT = HEIGHT SIZE_HINTS.X$L_SZHN_MIN_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_MIN_HEIGHT = HEIGHT SIZE_HINTS.X$L_SZHN_MAX_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_MAX_HEIGHT = HEIGHT C Create an icon. ICON = X$CREATE_BITMAP_FROM_DATA (DISPLAY, WINDOW, XLOGO, 32, 32) C Set the necessary properties. CALL X$SET_STANDARD_PROPERTIES (DISPLAY, WINDOW, WINNAME(:LWIN), + ICON_NAME, ICON, 0, 0, SIZE_HINTS) C Create a pixmap. PIXMAP = X$CREATE_PIXMAP (DISPLAY, WINDOW, WIDTH, HEIGHT, DEPTH) C Create default graphics contexts C for foreground and background. GC = X$CREATE_GC (DISPLAY, PIXMAP, 0, VALUES) GCB = X$CREATE_GC (DISPLAY, PIXMAP, 0, VALUES) C Set the foreground colors in the C graphics contexts. CALL X$SET_FOREGROUND (DISPLAY, GC, FORE) CALL X$SET_FOREGROUND (DISPLAY, GCB, BACK) C Ask for mapping notification. CALL X$SELECT_INPUT (DISPLAY, WINDOW, X$M_STRUCTURE_NOTIFY) C Display the window. CALL X$MAP_RAISED (DISPLAY, WINDOW) C Eat the mapping notification. C The loop is necessary because C the DECWindows window manager C reparents everything and sends C reparenting events before the C mapping event. 95 CALL X$NEXT_EVENT (DISPLAY, REPORT) IF (REPORT.EVNT_TYPE .NE. X$C_MAP_NOTIFY) GOTO 95 C Set up the asynchronous expose C event handler. CALL X$SELECT_ASYNC_EVENT (DISPLAY, WINDOW, X$C_EXPOSE, + GRXE03, %LOC (ARGS)) C Turn on exposure events. CALL X$SELECT_INPUT (DISPLAY, WINDOW, X$M_EXPOSURE) C Initialize the damaged region. CALL GRXE02 (WIDTH, HEIGHT, XMIN, XMAX, YMIN, YMAX) C Successful-- return display RBUF(1) = DISPLAY RBUF(2) = 1.0 NBUF = 2 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE C See if we are attached to a C real terminal. IER = LIB$GETDVI (DVI$_DEVCLASS, , 'SYS$COMMAND', DEVCLASS) C Wait for user acknowledgement. IF (IER .EQ. 1 .AND. DEVCLASS .EQ. DC$_TERM) + CALL LIB$GET_COMMAND (MESS, + CHAR (7) // 'Type to remove PGPLOT window: ', L) C Clean up resources. CALL X$SELECT_INPUT (DISPLAY, WINDOW, 0) CALL X$SELECT_ASYNC_EVENT (DISPLAY, WINDOW, X$C_EXPOSE, 0, 0) CALL X$UNMAP_WINDOW (DISPLAY, WINDOW) CALL X$FREE_GC (DISPLAY, GC) CALL X$FREE_GC (DISPLAY, GCB) CALL X$DESTROY_WINDOW (DISPLAY, WINDOW) CALL X$FREE_PIXMAP (DISPLAY, PIXMAP) CALL X$CLOSE_DISPLAY (DISPLAY) C Reset the initialization C variable. INIT = .TRUE. RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE C See if the user wants a C nonstandard size window. I0 = NINT (RBUF(1)) + 2 * IMIN + 1 J0 = NINT (RBUF(2)) + 2 * JMIN + 1 C See if it is different than what C we already have. IF (I0 .NE. WIDTH .OR. J0 .NE. HEIGHT) THEN C Recompute the size and position C parameters. WIDTH = I0 HEIGHT = J0 IMAX = WIDTH - IMIN - 1 JMAX = HEIGHT - JMIN -1 XOFF = (XPIX - WIDTH) / 2 YOFF = (YPIX - HEIGHT) / 2 C Turn off expose events to avoid C PIXMAP being invalid to the C asynchronous expose event C handler. CALL X$SELECT_INPUT (DISPLAY, WINDOW, 0) C Destroy the old pixmap. CALL X$FREE_PIXMAP (DISPLAY, PIXMAP) C Create a new pixmap. PIXMAP = X$CREATE_PIXMAP (DISPLAY, WINDOW, WIDTH, HEIGHT, + DEPTH) C Reset the size hints for the C window manager. SIZE_HINTS.X$L_SZHN_FLAGS = X$M_P_POSITION .OR. X$M_P_SIZE .OR. + X$M_P_MIN_SIZE .OR. X$M_P_MAX_SIZE SIZE_HINTS.X$L_SZHN_X = XOFF SIZE_HINTS.X$L_SZHN_Y = YOFF SIZE_HINTS.X$L_SZHN_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_HEIGHT = HEIGHT SIZE_HINTS.X$L_SZHN_MIN_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_MIN_HEIGHT = HEIGHT SIZE_HINTS.X$L_SZHN_MAX_WIDTH = WIDTH SIZE_HINTS.X$L_SZHN_MAX_HEIGHT = HEIGHT C Send the hints to the window C manager. CALL X$SET_STANDARD_PROPERTIES (DISPLAY, WINDOW, + WINNAME(:LWIN), ICON_NAME, ICON, 0, 0, SIZE_HINTS) C Resize the window. CALL X$RESIZE_WINDOW (DISPLAY, WINDOW, WIDTH, HEIGHT) C Wait for the server to catch C up. CALL X$SYNC (DISPLAY, .FALSE.) C Turn on exposure events. CALL X$SELECT_INPUT (DISPLAY, WINDOW, X$M_EXPOSURE) END IF C Clear the pixmap. CALL X$FILL_RECTANGLE (DISPLAY, PIXMAP, GCB, 0, 0, WIDTH, HEIGHT) C Clear the window. CALL X$CLEAR_WINDOW (DISPLAY, WINDOW) C Reset the damaged region. CALL GRXE02 (WIDTH, HEIGHT, XMIN, XMAX, YMIN, YMAX) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE C Transform the input coordinates. I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(2)) I1 = NINT (RBUF(3)) + IMIN J1 = JMAX - NINT (RBUF(4)) C Draw the line. CALL X$DRAW_LINE (DISPLAY, PIXMAP, GC, I0, J0, I1, J1) C Update the damaged region. CALL GRXE01 (1, I0, J0, I1, J1, XMIN, XMAX, YMIN, YMAX) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE C Transform the input coordinates. I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(2)) C Draw the point. CALL X$DRAW_POINT (DISPLAY, PIXMAP, GC, I0, J0) C Update the damaged region. CALL GRXE01 (0, I0, J0, I0, J0, XMIN, XMAX, YMIN, YMAX) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C Make sure the server is caught C up. CALL X$SYNC (DISPLAY, .FALSE.) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = NINT (RBUF(1)) C Handle monochrome displays C properly. IF (.NOT. MONO) THEN CALL X$SET_FOREGROUND (DISPLAY, GC, PIXELS(IC + 1)) ELSE IF (IC .EQ. 1) THEN CALL X$SET_FOREGROUND (DISPLAY, GC, FORE) ELSE CALL X$SET_FOREGROUND (DISPLAY, GC, BACK) END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE C Copy pixmap to server. IF (XMAX .NE. -1) CALL X$COPY_AREA (DISPLAY, PIXMAP, WINDOW, GC, + XMIN, YMIN, XMAX - XMIN + 1, YMAX - YMIN + 1, XMIN, YMIN) C Make sure the server is caught C up. CALL X$SYNC (DISPLAY, .FALSE.) C Reset damaged region. CALL GRXE02 (WIDTH, HEIGHT, XMIN, XMAX, YMIN, YMAX) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C 170 CONTINUE C Create and display the graphics C cursor. CURS = X$CREATE_FONT_CURSOR (DISPLAY, X$C_CROSS_HAIR_CURSOR) CALL X$DEFINE_CURSOR (DISPLAY, WINDOW, CURS) IF (.NOT. MONO) CALL X$RECOLOR_CURSOR (DISPLAY, CURS, RED, BLACK) C Convert input coordinates. I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(2)) C Set input focus to avoid C unwanted data entry. CALL X$GET_INPUT_FOCUS (DISPLAY, FWINDOW, FREVERT) CALL X$SET_INPUT_FOCUS (DISPLAY, WINDOW, X$C_REVERT_TO_PARENT, + X$C_CURRENT_TIME) C Set cursor to the correct spot. CALL X$WARP_POINTER (DISPLAY, X$C_NONE, WINDOW, + 0, 0, 0, 0, I0, J0) C Turn on event processing. CALL X$SELECT_INPUT (DISPLAY, WINDOW, X$M_KEY_PRESS .OR. + X$M_BUTTON_PRESS .OR. X$M_EXPOSURE) C Make sure the server is caught C up. CALL X$SYNC (DISPLAY, .FALSE.) C Loop until we get an entry from C the user. DO WHILE (.TRUE.) C Wait for an event to occur. We C ignore no expose events and C graphics expose events. CALL X$NEXT_EVENT (DISPLAY, REPORT) C Process the window exposure. IF (REPORT.EVNT_TYPE .EQ. X$C_EXPOSE) THEN CALL X$COPY_AREA (DISPLAY, PIXMAP, WINDOW, GC, + REPORT.EVNT_EXPOSE.X$L_EXEV_X, + REPORT.EVNT_EXPOSE.X$L_EXEV_Y, + REPORT.EVNT_EXPOSE.X$L_EXEV_WIDTH, + REPORT.EVNT_EXPOSE.X$L_EXEV_HEIGHT, + REPORT.EVNT_EXPOSE.X$L_EXEV_X, + REPORT.EVNT_EXPOSE.X$L_EXEV_Y) C The user pressed a mouse button. ELSE IF (REPORT.EVNT_TYPE .EQ. X$C_BUTTON_PRESS) THEN C Record the position I0 = REPORT.EVNT_BUTTON.X$L_BTEV_X J0 = REPORT.EVNT_BUTTON.X$L_BTEV_Y C Translate the mouse buttons to C the common letters Add, Delete, C and eXit. IF (REPORT.EVNT_BUTTON.X$L_BTEV_BUTTON .EQ. + X$C_BUTTON1) THEN BUFFER(1:1) = 'A' ELSE IF (REPORT.EVNT_BUTTON.X$L_BTEV_BUTTON .EQ. + X$C_BUTTON2) THEN BUFFER(1:1) = 'D' ELSE BUFFER(1:1) = 'X' END IF C Ignore this event if it is C outside the graphics boundaries. IF (I0 .GE. IMIN .AND. I0 .LE. IMAX .AND. + J0 .GE. JMIN .AND. J0 .LE. JMAX) GOTO 175 CALL X$BELL (DISPLAY, 0) CALL X$SYNC (DISPLAY, .FALSE.) C Translate the key pressed by the C user. ELSE IF (REPORT.EVNT_TYPE .EQ. X$C_KEY_PRESS) THEN I0 = REPORT.EVNT_KEY.X$L_KYEV_X J0 = REPORT.EVNT_KEY.X$L_KYEV_Y BUFLEN = X$LOOKUP_STRING (REPORT.EVNT_KEY, + BUFFER, 10, KEYSYM, ) C Ignore this event if it did not C produce a single character. IF (BUFLEN .EQ. 1) THEN C Ignore this event if it is C outside the graphics boundaries. IF (I0 .GE. IMIN .AND. I0 .LE. IMAX .AND. + J0 .GE. JMIN .AND. J0 .LE. JMAX) GOTO 175 CALL X$BELL (DISPLAY, 0) CALL X$SYNC (DISPLAY, .FALSE.) END IF END IF END DO C Reset event processing. 175 CALL X$SELECT_INPUT (DISPLAY, WINDOW, X$M_EXPOSURE) C Return the cursor to its C original state. CALL X$UNDEFINE_CURSOR (DISPLAY, WINDOW) CALL X$FREE_CURSOR (DISPLAY, CURS) CALL X$SET_INPUT_FOCUS (DISPLAY, FWINDOW, FREVERT, + X$C_CURRENT_TIME) C Make sure the server is caught C up. CALL X$SYNC (DISPLAY, .FALSE.) C Set the return values. CHR(1:1) = BUFFER(1:1) RBUF(1) = REAL (I0 - IMIN) RBUF(2) = REAL (JMAX - J0) NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE C First time, set number of points C in polygon and allocate the C memory for the array. IF (REMCAL .EQ. 0) THEN NPTS = NINT (RBUF(1)) REMCAL = NPTS IER = GRGMEM (SIZEOF (POINT) * NPTS, POINTS) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to allocate temporary buffer.') END IF ELSE C Second and succeeding calls, C change counter and load arrays. REMCAL = REMCAL - 1 I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(2)) CALL GRXE00 (NPTS, %VAL (POINTS), REMCAL, I0, J0) C Calculate the damaged region. CALL GRXE01 (0, I0, J0, I0, J0, XMIN, XMAX, YMIN, YMAX) C If last call, fill the area and C deallocate the memory. IF (REMCAL .EQ. 0) THEN CALL X$FILL_POLYGON (DISPLAY, PIXMAP, GC, %VAL (POINTS), + NPTS, X$C_POLYCOMPLEX, X$C_COORD_MODE_ORIGIN) IER = GRFMEM (SIZEOF (POINT) * NPTS, POINTS) IF (IER .NE. SS$_NORMAL) THEN CALL GRGMSG (IER) CALL GRQUIT ('Failed to deallocate temporary buffer.') END IF END IF END IF RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE C Ignore for a static or C monochrome device. IF (.NOT. MONO) THEN C Determine the color index. IC = NINT (RBUF(1)) C Load the color structure. COLOR.X$L_COLR_PIXEL = PIXELS(IC + 1) JLONG = NINT (RBUF(2) * 65535.0) COLOR.X$W_COLR_RED = JWORD(1) JLONG = NINT (RBUF(3) * 65535.0) COLOR.X$W_COLR_GREEN = JWORD(1) JLONG = NINT (RBUF(4) * 65535.0) COLOR.X$W_COLR_BLUE = JWORD(1) COLOR.X$B_COLR_FLAGS = X$M_DO_RED .OR. X$M_DO_GREEN .OR. + X$M_DO_BLUE C Tell the server about the new C definition. CALL X$STORE_COLOR (DISPLAY, CMAP, COLOR) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle Fill. ----------------------------------------- C 240 CONTINUE C Figure out the position of the C rectangle. I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(4)) C Determine the size of the C rectangle. I1 = NINT (RBUF(3) - RBUF(1) + 1.0) J1 = NINT (RBUF(4) - RBUF(2) + 1.0) C Draw the rectangle into the C display. CALL X$FILL_RECTANGLE (DISPLAY, PIXMAP, GC, I0, J0, I1, J1) C Calculate the damaged region. CALL GRXE01 (1, I0, J0, I0 + I1 - 1, J0 + J1 - 1, + XMIN, XMAX, YMIN, YMAX) RETURN C C--- IFUNC=25, --------------------------------------------------------- C (Not implemented: ignored) C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels ------------------------------------------ C 260 CONTINUE C This should only be called if C there are more than four planes C present and the display can C handle defining colors. IF (.NOT. LOPIX) THEN GOTO 900 ELSE C Calculate where to put the line. I0 = NINT (RBUF(1)) + IMIN J0 = JMAX - NINT (RBUF(2)) C Load the image data into the C the array. DO 265 IC = 1, NBUF - 2 KWORD = PIXELS (NINT (RBUF(IC + 2)) + 1) IMAGE(IC) = KBYTE(1) 265 CONTINUE C Create an image structure. CALL X$CREATE_IMAGE (DISPLAY, VISUAL, DEPTH, X$C_Z_PIXMAP, 0, + IMAGE, NBUF - 2, 1, 8, 0, XI) C Draw the line into the display. CALL X$PUT_IMAGE (DISPLAY, PIXMAP, GC, XI, 0, 0, I0, J0, + NBUF - 2, 1) C Calculate the damaged region. CALL GRXE01 (1, I0, J0, I0 + NBUF - 3, J0, + XMIN, XMAX, YMIN, YMAX) END IF RETURN C----------------------------------------------------------------------- END C*GRXE00 -- PGPLOT XE driver, load polygon array C+ SUBROUTINE GRXE00 (N0, POINTS, N, X, Y) IMPLICIT NONE INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF' INTEGER*4 N, N0, X, Y RECORD /X$POINT/ POINTS(N0) C----------------------------------------------------------------------- C Load the polygon array with the C passed vertex. POINTS(N0 - N).X$W_GPNT_X = X POINTS(N0 - N).X$W_GPNT_Y = Y C----------------------------------------------------------------------- RETURN END C*GRXE01 -- PGPLOT XE driver, calculate 'damaged' region. C+ SUBROUTINE GRXE01 (LINE, I0, J0, I1, J1, XMIN, XMAX, YMIN, YMAX) IMPLICIT NONE INTEGER*4 I0, I1, J0, J1, LINE, XMAX, XMIN, YMAX, YMIN C----------------------------------------------------------------------- C Update the damaged region. IF (I0 .GT. XMAX) XMAX = I0 IF (I0 .LT. XMIN) XMIN = I0 IF (J0 .GT. YMAX) YMAX = J0 IF (J0 .LT. YMIN) YMIN = J0 C See if we were passed a C rectangle and update the C damaged region accordingly. IF (LINE .EQ. 1) THEN IF (I1 .GT. XMAX) XMAX = I1 IF (I1 .LT. XMIN) XMIN = I1 IF (J1 .GT. YMAX) YMAX = J1 IF (J1 .LT. YMIN) YMIN = J1 END IF C----------------------------------------------------------------------- RETURN END C*GRXE02 -- PGPLOT XE driver, reset 'damaged' region. C+ SUBROUTINE GRXE02 (WIDTH, HEIGHT, XMIN, XMAX, YMIN, YMAX) IMPLICIT NONE INTEGER*4 HEIGHT, WIDTH, XMAX, XMIN, YMAX, YMIN C----------------------------------------------------------------------- C Reset the boundaries of the C damaged region. XMAX = -1 YMAX = -1 XMIN = WIDTH + 1 YMIN = HEIGHT + 1 C----------------------------------------------------------------------- RETURN END C*GRXE03 -- PGPLOT XE driver, aysynchronous redrawing routine. C+ SUBROUTINE GRXE03 (ARGS) IMPLICIT NONE INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF' INTEGER*4 ARGS(4) RECORD /X$EVENT/ EVENT C----------------------------------------------------------------------- C Get all of the exposure events. DO WHILE (X$CHECK_WINDOW_EVENT (ARGS(1), ARGS(3), + X$M_EXPOSURE, EVENT)) C If part of the window has been C exposed, redraw that part. We C ignore no expose events and C graphics expose events. IF (EVENT.EVNT_TYPE .EQ. X$C_EXPOSE) THEN CALL X$COPY_AREA (ARGS(1), ARGS(2), ARGS(3), ARGS(4), + EVENT.EVNT_EXPOSE.X$L_EXEV_X, + EVENT.EVNT_EXPOSE.X$L_EXEV_Y, + EVENT.EVNT_EXPOSE.X$L_EXEV_WIDTH, + EVENT.EVNT_EXPOSE.X$L_EXEV_HEIGHT, + EVENT.EVNT_EXPOSE.X$L_EXEV_X, + EVENT.EVNT_EXPOSE.X$L_EXEV_Y) END IF END DO C----------------------------------------------------------------------- RETURN END Ignore this eventpgplot/drivers/zedriv.f010064400040640000322000000160420641627024200156700ustar00tjpcitmbr00000400000017* Date: 27-MAR-1987 11:28:46 * From: AFT%UK.AC.CAM.AST-STAR@AC.UK * To: TJP@CITPHOBO * Subject: ZEDRIVER.FOR (3) C*ZEDRIV -- PGPLOT Zeta Plotter driver SUBROUTINE ZEDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) C--- GRPCKG driver for ZETA plotter. C---- C Supported device: Zeta 8 Digital Plotter. C Device type code: /ZEta C Default file name: PGPLOT.ZET C Default view surface dimensions: 11 inches by 11 inches. Current C version does not allow larger plots although the manual indicates C plots up to 144 feet are possible. C Resolution: This version is written for the case where the resolution C switch is set to .025 mm. Actual resolution depends on thickness C of pen tip. C Color capability: Color indices 1 to 8 are supported corresponding C to pens 1-8. It is not possible to erase lines. C Input capability: None. C File format: Variable length records with Carriage control of LIST. C Obtaining hardcopy: On Starlink print the file on the queue associated C with the Zeta plotter. If the Plotter is attached to a terminal C line, then TYPEing the file at the terminal will produce a plot. C On Starlink: C $ PRINT/NOFEED/QUE=ZETA PGPLOT.ZET C C To stop a Zeta plot job, once it has been started, use the buttons C on the plotter. Press PAUSE, NEXT PLOT and CLEAR. Only after C this sequence is it safe to delete the job from the ZETA Queue. C Failing to press the NEXT PLOT button will not correctly advance C the paper. Failing to press CLEAR but, deleteing the current C job can prevent the following plot from being plotted. C C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- C IMPLICIT NONE CHARACTER*(*) TYPE PARAMETER (TYPE='ZETA (Zeta 8 Digital Plotter)') INTEGER IFUNC,NBUF,LCHR,I0,J0,I1,J1 REAL RBUF(6) CHARACTER CHR*(*) INTEGER GRGE00 CHARACTER COL(0:7)*2 INTEGER LUN,MXCNT,ICNT,IBADR SAVE LUN,MXCNT,ICNT,IBADR DATA COL/'6A','61','62','63','64','65','66','67'/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, : 110,120,130,140,150,160) IFUNC GOTO 999 C--- C--- IFUNC= 1, Return device name. 10 CHR=TYPE LCHR=LEN(TYPE) RETURN C--- C--- IFUNC= 2, Return Physical min and max for plot device. 20 RBUF(1)=0 RBUF(2)=11175 RBUF(3)=0 RBUF(4)=11175 RBUF(5)=1 RBUF(6)=8 NBUF=4 RETURN C--- C--- IFUNC= 3, Return device resolution. 30 RBUF(1)=1007.0 RBUF(2)=1007.0 RBUF(3)=10 NBUF=3 RETURN C--- C--- IFUNC= 4, Return misc device info. 40 CHR='HNNNNNNNNN' LCHR=10 RETURN C--- C--- IFUNC= 5, Return default file name. 50 CHR='PGPLOT.ZET' LCHR=LEN(CHR) RETURN C--- C--- IFUNC= 6, Return default physical size of plot. 60 RBUF(1)=0 RBUF(2)=11175 RBUF(3)=0 RBUF(4)=11175 RETURN C--- C--- IFUNC= 7, Return misc defaults. 70 RBUF(1)=15 NBUF=1 RETURN C--- C--- IFUNC= 8, Set active plot. 80 CALL INIT03(0,LUN,0) RETURN C--- C--- IFUNC= 9, Open workstation. 90 RBUF(2)=GRGE00('FFL',LUN,CHR,LCHR) RBUF(1)=LUN IF(RBUF(2).EQ.1) THEN MXCNT=130 CALL GRGMEM(MXCNT,IBADR) ICNT=0 CALL INIT03(0,LUN,0) END IF RETURN C--- C--- IFUNC=10, Close workstation. 100 CLOSE(UNIT=LUN) CALL GRFLUN(LUN) CALL GRFMEM(MXCNT,IBADR) RETURN C--- C--- IFUNC=11, Begin Picture. 110 CALL GRGE02(%ref('ZZZZZZZZZZ'), 10, %val(IBADR),ICNT,MXCNT) CALL GRGE02(%ref('0000000000CIII'), 14, %val(IBADR),ICNT,MXCNT) CALL INZE01 RETURN C--- C--- IFUNC=12, Draw line. 120 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) I1=NINT(RBUF(3)) J1=NINT(RBUF(4)) CALL GRZE01(I0,J0,I1,J1,%val(IBADR),ICNT,MXCNT) RETURN C--- C--- IFUNC=13, Draw dot. 130 I0=NINT(RBUF(1)) J0=NINT(RBUF(2)) CALL GRZE01(I0,J0,I0,J0,%val(IBADR),ICNT,MXCNT) RETURN C--- C--- IFUNC=14, End picture. C--- Move pen to origin, C--- Advance paper by 15 inches, C--- Reset. 140 CALL GRZE01(0,0,0,0,%val(IBADR),ICNT,MXCNT) CALL GRGE02(%ref('1OGUE'),5,%val(IBADR),ICNT,MXCNT) CALL GRGE02(%ref('70Z') ,3,%val(IBADR),ICNT,MXCNT) RETURN C--- C--- IFUNC=15, Select pen. 150 I0=MAX(0,MIN(NINT(RBUF(1)),7)) RBUF(1)=I0 CALL GRGE02(%ref(COL(I0)),2,%val(IBADR),ICNT,MXCNT) RETURN C--- C--- IFUNC=16, Flush buffer. 160 CALL GRGE03(%val(IBADR),ICNT) RETURN C--- C--- Flag function not implemented. 999 NBUF=-1 RETURN C--- END C*GRZE01 -- PGPLOT Zeta Plotter driver, line segment SUBROUTINE GRZE01 (I0,J0,I1,J1,IBUF,ICNT,MXCNT) C----------------------------------------------------------------------- C GRPCKG (internal routine, ZETA): draw a line segment. C C Arguments: C C I0,J0 (integer, input): the column and row numbers of the starting C point. C I1,J1 (integer, input): the column and row numbers of the end point. C C 15-NOV-83 C----------------------------------------------------------------------- C IMPLICIT NONE INTEGER ISIZE PARAMETER (ISIZE=11176) INTEGER I0, I1, J0, J1, IBUF(*), ICNT, MXCNT CHARACTER CPEN(2), CSTR*8 INTEGER II0, II1, JJ0, JJ1, I INTEGER IDX(2), IDY(2), LASTX, LASTY SAVE LASTX,LASTY DATA CSTR(2:2)/'R'/, CPEN/'1','2'/ C--- II0= MOD(I0, ISIZE) II1= MOD(I1, ISIZE) JJ0= MOD(J0, ISIZE) JJ1= MOD(J1, ISIZE) C IDX(1)= II0-LASTX IDY(1)= JJ0-LASTY IDX(2)= II1-II0 IDY(2)= JJ1-JJ0 C C First iteration moves to starting point, second draws line. C DO 100 I= 1, 2 CSTR(1:1)= CPEN(I) IF(IDX(I).NE.0 .OR. IDY(I).NE.0) THEN CALL GRZE04(IDX(I), CSTR, 3) CALL GRZE04(IDY(I), CSTR, 6) CALL GRGE02(%ref(CSTR), 8, IBUF,ICNT,MXCNT) ELSE IF(I .EQ. 2) THEN CALL GRGE02(%ref(CSTR), 1, IBUF,ICNT,MXCNT) END IF 100 CONTINUE C LASTX= II1 LASTY= JJ1 RETURN C--- ENTRY INZE01 C C This entry is called by to initialize a new plot. C LASTX= 0 LASTY= 0 RETURN END C*GRZE04 -- PGPLOT Zeta Plotter driver, string generation SUBROUTINE GRZE04(NUM, CSTR, NC) C----------------------------------------------------------------- C Generate strings for sending to Zeta plotter. C C- NUM I I Number to be converted. C- CSTR I/O C Output character array. C- NC I/O I Start location in CSTR C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C IMPLICIT NONE INTEGER NUM,NC CHARACTER CSTR*(*) INTEGER ITMP, I, IDIV, IND CHARACTER CFIG(0:31) C DATA CFIG/'0','1','2','3','4','5','6','7','A', : 'B','C','D','E','F','G','H','I','J','K','L','M','N','O', : 'P','Q','R','S','T','U','V','W','X'/ C ITMP=NUM IF(NUM .LT. 0) ITMP= NUM+32768 IDIV= 1 DO 100 I=NC+2,NC,-1 IND= MOD(ITMP/IDIV, 32) IF(IND .LT. 0) IND= 32+IND CSTR(I:I)= CFIG(IND) IDIV= IDIV*32 100 CONTINUE END pgplot/drivers/aaaread.me010064400040640000322000000007660566045325300161320ustar00tjpcitmbr00000400000017pgplot/drivers This directory contains source code for all the PGPLOT device handlers. Handlers written in Fortran have file name "XXdriv.f" and handlers written in C have file name "XXdriv.c". Many of the device handlers are specific for a single system and cannot be compiled on all systems. Most of the device handlers are self-contained in a single file, but a few require additional subroutines or header files. For a complete list of drivers, see file drivers.list in the pgplot directory. pgplot/drivers/gldriv.f010064400040640000322000000227600662171473100156640ustar00tjpcitmbr00000400000017 SUBROUTINE GLDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Hewlett Packard HPGL plotter(s). C----------------------------------------------------------------------- C Version 1.0 - 1988 Mar 14 - B. H. Toby C 9/88 bull: added page eject to IFUNC 14 C Version 2.0 - 1994 Mar 16 - T. J. Pearson (dual mode, standard F77) C Version 2.1 - 1994 Nov 6 - TJP: use PGPLOT_GL_TERMINAL. C Version 3.0 - 1997 Jun 11 - TJP: add SC to specify page size. C Version 3.1 - 1998 Oct 23 - TJP: correct failure to close file. C Version 3.2 - 1998 Nov 9 - TJP: allow up to 8 pens. C----------------------------------------------------------------------- C This routine has been written specifically for the HP7475A C Plotter, but should support most HPGL devices, perhaps with C minor modifications. C C Color: C Color Index 1-8 are mapped to requests for pens 1-8, so C the actual color depends on what pen is installed. C Color representation requests (PGSCR) are ignored. C C If environment variable PGPLOT_GL_TERMINAL has value YES (or any C string beginning with Y or y), it is assumed that the C output device is a plotter connected BEFORE the terminal using C the Y-cable (HP part #17455A), in which case the plotter is C ``turned on'' using a ".(" and xon/xoff handshaking is C enabled using ".I81;;17:" and ".N;19:". C Otherwise, it is the user's responsibility to C add control codes, if needed. C C If there is more than one plot and the plot is on a terminal, C a prompt will be generated, allowing the page to be advanced. C C ref. HP 7475A Interfacing and Programming Manual P/N 7475-90001 C----------------------------------------------------------------------- CHARACTER*(*) LTYPE, PTYPE, DEFNAM PARAMETER (LTYPE= : 'HPGL (Hewlett Packard HPGL plotter, landscape orientation)') PARAMETER (PTYPE= : 'VHPGL (Hewlett Packard HPGL plotter, portrait orientation)') PARAMETER (DEFNAM='pgplot.hpgl') CHARACTER*80 MSG CHARACTER*80 INSTR INTEGER LASTI, LASTJ, UNIT, IC, IER INTEGER I0, J0, I1, J1, L INTEGER I, PLOTNO LOGICAL ITERM INTEGER GRGCOM, GROPTX SAVE C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 IF (MODE.EQ.1) THEN C -- landscape (mode=1) CHR = LTYPE LCHR = LEN(LTYPE) ELSE C -- portrait (mode=2) CHR = PTYPE LCHR = LEN(PTYPE) END IF RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(3) = 0 RBUF(5) = 1 RBUF(6) = 8 NBUF = 6 IF (MODE.EQ.1) THEN C -- landscape (mode=1) RBUF(2) = 16640 RBUF(4) = 11040 ELSE C -- portrait (mode=2) RBUF(2) = 11040 RBUF(4) = 16640 END IF RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 1016.0 RBUF(2) = 1016.0 RBUF(3) = 20 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C No thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(3) = 0 NBUF = 4 IF (MODE.EQ.1) THEN C -- landscape (mode=1) RBUF(2) = 10365 RBUF(4) = 7962 ELSE C -- portrait (mode=2) RBUF(2) = 7962 RBUF(4) = 10365 END IF RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 10 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C Try to open the graphics device CALL GRGLUN(UNIT) IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN MSG='Cannot open graphics device '//CHR(1:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 RETURN END IF C is the output device a terminal? CALL GRGENV('GL_TERMINAL', INSTR, L) ITERM = (INSTR(1:1).EQ.'Y' .OR. INSTR(1:1).EQ.'y') RBUF(1) = UNIT RBUF(2) = 1 NBUF = 2 LASTI = -1 LASTJ = -1 IF (ITERM) THEN C this turns on the plotter WRITE (UNIT, '(A)') CHAR(27)//'.(' C this sets up Xon/Xoff protocol WRITE (UNIT, '(A)') CHAR(27)//'.I81;;17:' WRITE (UNIT, '(A)') CHAR(27)//'.N;19:' ENDIF IF (MODE.EQ.1) THEN C -- landscape (mode=1) WRITE (UNIT, '(A)') 'IN;' ELSE C -- portrait (mode=2) WRITE (UNIT, '(A)') 'IN;RO90;IP;IW;' END IF PLOTNO = 1 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE WRITE (UNIT, '(A)') 'SP;' IF (ITERM) THEN C this turns off the plotter WRITE (UNIT, '(A)') CHAR(27)//'.)' ENDIF CLOSE (UNIT) CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C if the plot is interactive, and we are starting a second or third (...) C picture, allow a chance to change the paper. IF (ITERM .AND. PLOTNO .GT. 1) THEN C turn off the plotter WRITE (UNIT, '(A)') CHAR(27)//'.)' C send a prompt IER = GRGCOM(MSG, CHAR(7)// 1 'Reload paper, then press : ', I) C turn on the plotter WRITE (UNIT, '(A)') CHAR(27)//'.(' ENDIF CALL GRFAO('SC0,#,0,#;SP1;', L, INSTR, : NINT(RBUF(1)), NINT(RBUF(2)), 0, 0) WRITE (UNIT, '(A)') INSTR(:L) PLOTNO = PLOTNO + 1 WRITE (UNIT, '(A)') 'PA;' RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF ( (I0.NE.LASTI) .OR. (J0.NE.LASTJ) ) THEN C -- move with pen up C -- Encode the coordinates into the command string CALL GRFAO('PU#,#;', L, INSTR, I0, J0, 0, 0) C -- Write the command string to the plot file WRITE (UNIT, '(A)') INSTR(:L) ENDIF C -- move with pen down C -- Encode the coordinates into the command string CALL GRFAO('PD#,#;', L, INSTR, I1, J1, 0, 0) C -- Write the command string to the plot file WRITE (UNIT, '(A)') INSTR(:L) LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) IF ((I0.NE.LASTI) .OR. (J0.NE.LASTJ)) THEN C -- move with pen up C -- Encode the coordinates into the command string CALL GRFAO('PU#,#;PD;', L, INSTR, I0, J0, 0, 0) C -- Write the command string to the plot file WRITE (UNIT, '(A)') INSTR(:L) ELSE C -- no need to move, just lower the pen WRITE (UNIT, '(A)') 'PD;' ENDIF LASTI = I0 LASTJ = J0 RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE C move the pen off the page WRITE (UNIT, '(A)') 'PU32000,32000;PG;' RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE IC = NINT(RBUF(1)) IF (IC.LT.1) IC = 1 WRITE (UNIT,'(A,I2,A)') 'SP',IC,';' RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Null operation: buffering is not implemented.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C IGnored. C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE WRITE (UNIT, '(A)') CHR(:LCHR) LASTI = -1 RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in HPGL device driver: '//MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END pgplot/drivers/pxdriv.f010064400040640000322000000243050566772427100157170ustar00tjpcitmbr00000400000017C*PXDRIV -- PGPLOT Printronix driver C+ SUBROUTINE PXDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Printronix device. C C Version 1.0 - 1987 Jun 8 - T. J. Pearson. C Version 1.1 - 1987 Aug 31 - truncate output lines as necessary. C======================================================================= C C Supported device: Printronix P300 or P600 dot-matrix printer. C C Device type code: /PRINTRONIX. C C Default device name: PGPLOT.PRPLOT. C C Default view surface dimensions: 13.2in (horizontal) by 10.25in C (vertical). C C Resolution: 60 (x) x 72 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: Variable-length records, maximum 135 bytes, with C embedded carriage-control characters. A full-page plot occupies C 200 512-byte blocks. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='PRINTRONIX (Printronix P300/P600 printer)') PARAMETER (DEFNAM='PGPLOT.PRPLOT') BYTE FF PARAMETER (FF=12) C INTEGER UNIT, IER, IC, BX, BY, NPICT INTEGER GRGMEM, GRFMEM CHARACTER*10 MSG INTEGER BITMAP C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 791 RBUF(3) = 0 RBUF(4) = -1 RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 60.0 RBUF(2) = 72.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 791 RBUF(3) = 0 RBUF(4) = 737 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C -- dimensions of plot buffer BX = 132 ! 792/6 BY = 738 CALL GRGLUN(UNIT) RBUF(1) = UNIT NPICT = 0 OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='DELETE', STATUS='NEW', 2 RECL=128, 3 FORM='UNFORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF IER = GRGMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER CLOSE (UNIT=UNIT, DISPOSE='DELETE') CALL GRFLUN(UNIT) END IF RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE (UNIT=UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = GRFMEM(BX*BY, BITMAP) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C 110 CONTINUE NPICT = NPICT+1 C% type *,'Begin picture',NPICT IF (NPICT.GT.1) WRITE (UNIT=UNIT) FF CALL GRPX03(BX*BY, %val(BITMAP), 'C0'X) RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE CALL GRPX01(1, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE CALL GRPX01(0, RBUF, IC, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE C% type *,'End picture ',NPICT CALL GRPX02(UNIT, BX, BY, %val(BITMAP)) RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) IF (IC.LT.0 .OR. IC.GT.1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Not used.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called) C 200 CONTINUE GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called) C 220 CONTINUE GOTO 900 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- END C*GRPX01 -- PGPLOT Printronix driver, draw line C+ SUBROUTINE GRPX01 (LINE,RBUF,ICOL, BX, BY, BITMAP) INTEGER LINE REAL RBUF(4) INTEGER ICOL, BX, BY BYTE BITMAP(BX,BY) C C Draw a straight-line segment from absolute pixel coordinates C (RBUF(1),RBUF(2)) to (RBUF(3),RBUF(4)). The line either overwrites C (sets to black) or erases (sets to white) the previous contents C of the bitmap, depending on the current color index. Setting bits C is accomplished with a VMS BISB2 instruction, expressed in C Fortran as .OR.; clearing bits is accomplished with a VMS BICB2 C instruction, expressed in Fortran as .AND..NOT.. The line is C generated with a Simple Digital Differential Analyser (ref: C Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R End point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0:5) INTEGER LENGTH, KX, KY, K REAL D, XINC, YINC, XP, YP DATA QMASK /'01'x,'02'x,'04'x,'08'x,'10'x,'20'x/ C IF (LINE.GT.0) THEN D = MAX(ABS(RBUF(3)-RBUF(1)), ABS(RBUF(4)-RBUF(2))) LENGTH = D IF (LENGTH.EQ.0) THEN XINC = 0. YINC = 0. ELSE XINC = (RBUF(3)-RBUF(1))/D YINC = (RBUF(4)-RBUF(2))/D END IF ELSE LENGTH = 0 XINC = 0. YINC = 0. END IF XP = RBUF(1)+0.5 YP = RBUF(2)+0.5 IF (ICOL.NE.0) THEN DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .OR. 1 QMASK(MOD(KX,6)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K=0,LENGTH KX = XP KY = (BY-1)-INT(YP) BITMAP(KX/6+1,KY+1) = BITMAP(KX/6+1,KY+1) .AND. 1 (.NOT.QMASK(MOD(KX,6))) XP = XP + XINC YP = YP + YINC END DO END IF END C*GRPX02 -- PGPLOT Printronix driver, copy bitmap to output file C+ SUBROUTINE GRPX02 (UNIT, BX, BY, BITMAP) INTEGER UNIT, BX, BY BYTE BITMAP(BX,BY) C C Arguments: C UNIT (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE SUFFIX(3) DATA SUFFIX/ 5, 13, 10/ INTEGER I, J, K C C Write bitmap. C DO J=1,BY DO K=BX,2,-1 IF (BITMAP(K,J).NE.'C0'X) GOTO 10 END DO 10 WRITE (UNIT=UNIT) (BITMAP(I,J),I=1,K),SUFFIX END DO C C Write blank plot lines to fill up page C END C*GRPX03 -- PGPLOT Printronix driver, fill buffer with a specified character C+ SUBROUTINE GRPX03 (BUFSIZ,BUFFER,FILL) C C GRPCKG (internal routine): fill a buffer with a given character. C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C FILL (integer, input): the fill character. BUFSIZ bytes starting at C address BUFFER are set to contents of FILL. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE FILL BYTE BUFFER(BUFSIZ) C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END pgplot/drivers/nexsup.c010064400040640000322000000143750666502764500157300ustar00tjpcitmbr00000400000017/* nexsup.c--This is a 'support routine' used by the nedriv.f code, */ /* In brief, this is the main interface between the Fortran and */ /* C languages. It is called from Fortran and uses a UNIX socket */ /* to send messages to the PGPLOT viewer. */ /* 199-Feb-24 - update from nexsup.m - [AFT] */ #include #include #include #include #include #include int pgsock=-1; struct sockaddr_in server; #ifdef __STDC__ void grgetreply(int ifunc,int *ibuf,int *lbuf) #else void grgetreply(ifunc, ibuf, lbuf) int ifunc; int *ibuf; int *lbuf; #endif { /* Used by nexsup to send a message over the socket and wait */ /* for a reply back */ struct sockaddr_in replyadd; struct pgmess { unsigned char c1func; unsigned char c1len; char cmess[256]; }; struct pgmess sbuf; int msgsock, repsock; int i, itmp; /* We need a socket that pgview can reply to. Create descriptor. */ repsock = socket(AF_INET, SOCK_STREAM, 0); if (repsock < 0) { perror("opening stream socket"); exit(1); } /* Name socket using wildcards */ replyadd.sin_family = AF_INET; replyadd.sin_addr.s_addr = INADDR_ANY; replyadd.sin_port = 0; if (bind(repsock, (struct sockaddr *)&replyadd, sizeof(replyadd))) { perror("binding stream socket"); exit(1); } /* Find out assigned port number so we can forward to the server. */ itmp = sizeof(replyadd); if (getsockname(repsock, (struct sockaddr *)&replyadd, &itmp)) { perror("getting socket name"); exit(1); } /* Start accepting connections */ listen(repsock, 5); /* Now tell pgview the port that we are listen'ing on. Note, the port */ /* number is already in network byte order which is what pgview needs. */ sbuf.c1func = ifunc; sbuf.c1len = 2; memcpy(sbuf.cmess, &replyadd.sin_port, 2); if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); /* Now wait for the reply */ msgsock = accept(repsock, (struct sockaddr *)0, (int *)0); if (msgsock == -1) perror("accept"); else { *lbuf = read(msgsock, ibuf, 16); } close(msgsock); return; } #ifdef __STDC__ void nexsup_(int *ifunc, char *cbuf, float rtmp[], int len_cbuf) #else void nexsup_(ifunc, cbuf, rtmp, len_cbuf) int *ifunc; char *cbuf; float rtmp[]; int len_cbuf; #endif { struct hostent *hp; struct pgmess { unsigned char c1func; unsigned char c1len; char cmess[256]; }; struct pgmess sbuf; char *cdis, *cview; char cloc[256]; int ibuf[10]; int i, icnt, itmp, lbuf, lloc; if ( pgsock<0 ) { icnt = 0; do { /* Create socket descriptor. */ pgsock = socket(AF_INET, SOCK_STREAM, 0); if ( pgsock < 0) { perror("opening stream socket"); } /* Create socket address structure */ server.sin_family = AF_INET; cdis = (char *) getenv("DISPLAY"); if ( cdis==NULL ) cdis="localhost"; else { /* Convert a colon to null (end of string) */ for (i=0; ih_addr, hp->h_length); server.sin_port = htons(7974); /* Connect descriptor to address */ itmp=connect(pgsock,(struct sockaddr *)&server,sizeof(server)); if ( itmp<0 ) { close(pgsock); if ( icnt==0 ) { cview = (char *) getenv("PGVIEW"); if ( cdis==NULL || cview!=NULL ) { /* If PGVIEW is defined or DISPLAY is not defined, then try to launch pgview */ printf("Launching pgview...\n"); if ( cview==NULL ) cview="/LocalApps/pgview.app/pgview"; strcpy(cloc, cview); lloc=strlen(cloc); cloc[lloc]=' '; cloc[lloc+1]='&'; cloc[lloc+2]='\0'; system(cloc); } else { printf("Please launch pgview on your display system.\n"); } } sleep(1); if((icnt/5)*5 == icnt) printf("waiting...\n"); icnt=icnt+1; } } while (itmp<0 && icnt<20); if ( itmp < 0 ) { printf("Could not find port connected to pgview.\n"); exit(1); } } switch (*ifunc) { case 1: grgetreply(1, ibuf, &lbuf); rtmp[0]=(float)ntohl(ibuf[0]); rtmp[1]=(float)ntohl(ibuf[1]); rtmp[2]=(float)ntohl(ibuf[2]); rtmp[3]=(float)ntohl(ibuf[3]); break; case 2: sbuf.c1func = 2; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 3: /* Make sure we send the null character at the end. */ itmp=strlen(cbuf)+1; sbuf.c1func = 3; sbuf.c1len = itmp; memcpy(sbuf.cmess, cbuf, itmp); if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 4: grgetreply(4, ibuf, &lbuf); rtmp[0]=(float)ntohl(ibuf[0]); rtmp[1]=(float)ntohl(ibuf[1]); rtmp[2]=(float)ntohl(ibuf[2]); break; case 5: sbuf.c1func = 5; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 6: sbuf.c1func = 6; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 7: close(pgsock); pgsock=-1; break; default : printf("nexsup--Unknown function code= %d\n",*ifunc); break; } } pgplot/drivers/lvdriv.f010064400040640000322000000203720641627051000156720ustar00tjpcitmbr00000400000017C*LVDRIV -- PGPLOT driver for Digital LN03 printer (portrait mode) SUBROUTINE LVDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for Digital LN03 Laser Printer (PORTRAIT orientation) C File : LVDRIVER.FOR C----------------------------------------------------------------------- C Version 1.0 - 1989 Nov. Sid Penstone, Queen's University C Last Revision Dec.1.1989: Removed call to dot routine, now do it as C a zero length vector C----------------------------------------------------------------------- C This routine has been written specifically for the LN03-PLUS C Laser Printer C C NAME: '/LVN03' C C C In all case, the initialization sequences are written out, C whether or not the plotter is connected as a terminal, C or driven from an intermediate file. C C If there is more than one plot and the plot is on a terminal, C the page is ejected before the next one C C ref. Digital LN03 Programmer Reference Manual, P/N EK-OLN03-002 C C PHYICAL SIZE IS 7" BY 9" C----------------------------------------------------------------------- CHARACTER*(*) TYPE PARAMETER (TYPE='LVN03 (Digital LN03 Laser Printer, portrait)') C INTEGER MARGIN, NXPIX, NYPIX, NSIXROWS, NSIXCOLS PARAMETER(MARGIN=150) PARAMETER(NXPIX=2400) PARAMETER(NYPIX=3000) PARAMETER(NSIXROWS=(NYPIX/6)+2) PARAMETER(NSIXCOLS=NXPIX) CHARACTER*10 MSG INTEGER WIDTH,XLEFT,XRIGHT,YBOT,YTOP,INTENS, XMAX, YMAX, XMIN INTEGER UNIT, IER INTEGER I0, J0, I1, J1 INTEGER IK1, IK2, IK3, IK4, IK5, PLOTNO CHARACTER*1 ESC DATA XLEFT,XRIGHT,YTOP,YBOT/0,NXPIX,0,NYPIX/ DATA ESC /27/ DATA WIDTH /2/ LOGICAL ACTIVE(0:NSIXROWS) C Data for the allocation routines INTEGER GRGMEM, GRFMEM INTEGER BUFLEN, IPOINTS, IERR LOGICAL ALLOC SAVE BUFLEN, IPOINTS, ALLOC DATA ALLOC /.FALSE./ DATA IPOINTS /-1/ C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC GOTO 900 C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = NXPIX - 2*MARGIN RBUF(3) = 0 RBUF(4) = NYPIX - 2*MARGIN RBUF(5) = 0 RBUF(6) = 1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 300.0 RBUF(2) = 300.0 RBUF(3) = WIDTH NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C No thick lines) C 40 CHR = 'HNNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = 'PGPLOT.LN3' LCHR = 11 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = NXPIX-2*MARGIN RBUF(3) = 0 RBUF(4) = NYPIX-2*MARGIN NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 10 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE C Try to open the graphics device CALL GRGLUN(UNIT) OPEN (UNIT=UNIT,FILE=CHR(:LCHR),STATUS='NEW', 1 FORM='FORMATTED', CARRIAGECONTROL='LIST', 1 RECL=512,IOSTAT=IER) IF (IER.NE.0) THEN CALL ERRSNS(IK1,IK2,IK3,IK4,IK5) CALL GRWARN('Cannot open graphics device ' 1 //CHR(1:LCHR)) IF (IK2.NE.0 .AND. IK2.NE.1) CALL GRGMSG(IK2) IF (IK5.NE.0 .AND. IK5.NE.1) CALL GRGMSG(IK5) RBUF(2) = 0 RETURN ENDIF RBUF(1) = UNIT RBUF(2) = 1 NBUF = 2 C Now allocate the bitmap buffers (Assume integer*2) IF (.NOT. ALLOC) THEN BUFLEN = NSIXROWS * NSIXCOLS IERR = GRGMEM(2*BUFLEN, IPOINTS) IF (IERR .NE. 1 ) THEN CALL GRGMSG(IERR) CALL GRWARN('Memory allocation failure') RETURN ENDIF ALLOC = .TRUE. ENDIF C Clear the row flags (and the bit map) CALL LN03_CLEAR(%VAL(IPOINTS),BUFLEN,ACTIVE,NSIXROWS) C C always write the preamble C this resets the plotter WRITE (UNIT, '(A)') ESC//'c' C this sets it for portrait, origin at corner WRITE (UNIT, '(A)') ESC//'[?20 J' PLOTNO = 0 RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- 100 CONTINUE C always turn it off CLOSE (UNIT) CALL GRFLUN(UNIT) C Deallocate the buffer IF (ALLOC .OR. IPOINTS .GE. 0) THEN IERR = GRFMEM(2*BUFLEN, IPOINTS) IF (IERR .NE. 1 ) THEN CALL GRGMSG(IERR) CALL GRWARN('Deallocation failure') RETURN ENDIF ALLOC = .FALSE. IPOINTS = -1 ENDIF RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C WE COULD GET THE VALUE OF XMAX AND YMAX HERE YMAX = YBOT - 2*MARGIN XMIN = XLEFT + MARGIN XMAX = XRIGHT - MARGIN PLOTNO = PLOTNO + 1 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = XMIN + NINT(RBUF(1)) J0 = YMAX - NINT(RBUF(2)) I1 = XMIN + NINT(RBUF(3)) J1 = YMAX - NINT(RBUF(4)) CALL LN03_VECTOR(I0,J0,I1,J1,WIDTH,XLEFT,XRIGHT, 1 YTOP,YBOT,%val(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS,INTENS) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I0 = XLEFT + NINT(RBUF(1)) J0 = YBOT - NINT(RBUF(2)) CALL LN03_VECTOR(I0,J0,I0,J0,WIDTH,XLEFT,XRIGHT, 1 YTOP,YBOT,%VAL(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS,INTENS) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE CALL LN03_DUMP(UNIT,XLEFT,XMAX+WIDTH,YTOP+MARGIN,YMAX+WIDTH, 1 %val(IPOINTS),ACTIVE,NSIXROWS,NSIXCOLS) IF(ALLOC) THEN CALL LN03_CLEAR(%VAL(IPOINTS),BUFLEN,ACTIVE,NSIXROWS) ENDIF C Eject the paper with a form feed C WRITE (UNIT, '(A)') CHAR(12) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 INTENS = NINT(RBUF(1)) IF (INTENS .GT.1 ) INTENS = 1 RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C (Null operation: buffering is not implemented.) C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called.) C 170 GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 RETURN C Other colors are not implemented C C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE WRITE (UNIT, '(A)') CHR(:LCHR) RETURN C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in LN03 device driver: '//MSG) NBUF = -1 RETURN C----------------------------------------------------------------------- END solution. ------------------------------ C 30 RBUF(1) = 300.0 RBUF(2) = 300.0 RBUF(3) = WIDTH NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Hardcopy, No cursor, No dashepgplot/drivers/commands.h010064400040640000322000000420170562620720200161670ustar00tjpcitmbr00000400000017/* This file contains the definitions (and formats) for the command types, */ /* as well as any other constants needed for programs which access the */ /* Figaro/PGPLOT X Window display server. It should be included by any */ /* program which accesses the Figaro/PGPLOT X Window display server. All */ /* arguments are short (16-bit) except for the pixel values for the bitmap */ /* write command. If an odd number of pixels is written in the bitmap write */ /* command, the next command must be aligned on the next half-word (16-bit) */ /* boundary. Note that all points are given from the top left corner of the */ /* PIXMAP, not the window. This is so the point specification never changes */ /* no matter what is done to the window size. Only one command which returns */ /* a value to the requesting program (TOK_LG_MAX_DIM, for example) is allowed */ /* in a single transfer. If more than one are specified the final request is */ /* honored. The command does not need to be the last command in a sequence. */ /* A call to TOK_SET_LG_SIZE must not precede TOK_LG_DEF_SIZE in a command */ /* buffer. If it does, the old size of the window MAY (not will) be */ /* returned. */ /* Sam Southard, Jr. */ /* Created: 2-Nov-1990 */ /* 8-Nov-1990 SNS/CIT NAME_PROG, NAME_INCRATOM, NAME_DATAATOM, and */ /* NAME_SELATOM added. */ /* 14-Nov-1990 SNS/CIT TOK_DRAW_LINE now takes four arguments. */ /* TOK_DRAW_POLY no longer uses the curent cursor */ /* location as a starting point. TOK_LG_MAX_DIM through */ /* TOK_FILL_RECT added. */ /* 15-Nov-1990 SNS/CIT All commands except the bitmap-write (not added yet) */ /* modified to accept all short arguments. */ /* 19-Nov-1990 SNS/CIT TOK_SET_LG_CURS and TOK_LG_GET_CURS combined into */ /* TOK_LG_CURS. */ /* 20-Nov-1990 SNS/CIT TOK_LG_LINE_WID added. */ /* 12-Dec-1990 SNS/CIT TOK_SHOW_BM_WIN through TOK_SET_BM_SIZE added. */ /* 17-Dec-1990 SNS/CIT TOK_SET_BM_LUT description changed for better PGPLOT */ /* support. TOK_SET_BM_LUT and TOK_SET_LG_LUT now */ /* function differently, which should be changed in the */ /* future. */ /* 18-Dec-1990 SNS/CIT TOK_BM_CURS split into TOK_BM_SET_CURS and */ /* TOK_BM_GET_CURS for easier TVPCKG interface. */ /* 22-Apr-1991 SNS/CIT TOK_SET_BM_CSCALE and TOK_SET_BM_DSCALE added. */ /* 29-Apr-1991 SNS/CIT TOK_BM_ZOOMPAN added. */ /* 17-Jun-1991 SNS/CIT TOK_BM_FLUSH added. */ /* 1-Aug-1991 SNS/CIT TOM_BM_LINE added. */ /* 14-Aug-1991 SNS/CIT Commands no longer begin with TOK_ */ /* 20-Aug-1991 SNS/CIT COMBUFLEN no longer needed. */ /* 17-Oct-1991 SNS/CIT SET_BM_SIZE and BM_WRITE now take the number of bits */ /* in a pixel */ /* 26-Feb-1992 SNS/CIT LG_PIXLINE and SET_LG_CSCALE added */ /* 25-Jun-1992 SNS/CIT SET_BM_LUT now takes the number of bits in a pixel. */ /* 9-Jul-1992 SNS/CIT Argument definitions for SET_BM_SIZE and SET_LG_SIZE */ /* reconciled. They now both take the new size, while */ /* SET_LG_LUT had been taking the maximum coordinates */ /* and the comments in this file claimed that both of */ /* them took the maximum coordinates. */ /* 22-Sep-1992 SNS/CIT special value definition added to BM_ZOOMPAN comment. */ /* Added definitions of SET_BM_SH_SIZE and BM_SH_UPDATE. */ /* 23-Sep-1992 SNS/CIT SET_BM_DSCALE changed to use ASCII strings. */ /* 27-Sep-1992 SNS/CIT SET_LG_CSCALE changed to use ASCII strings. */ /* 5-Oct-1992 ARC/HI Added DO_BOX and DO_AUTOSCALE commands. */ /* 14-Oct-1992 SNS/CIT RCS id string now added if INC_HEADER_RCS #define'd. */ /* Now protected from double inclusion */ /* 4-Nov-1992 SNS/CIT AUTOSCALE now takes ASCII-encoded floats which range */ /* from 0.0 to 100.0 */ #ifndef INC_COMMANDS_H #define INC_COMMANDS_H #ifndef lint #ifdef INC_HEADER_RCS static char commands_h_rcsid[]="@(#)$Id: commands.h,v 1.13 1994/02/07 04:33:26 figaro Exp $"; #endif #endif /* some constants needed for programs accessing the display server */ #define NAME_PROG "figdisp" /* The name of the program. It is used to */ /* ensure that only one copy of the program */ /* is running on each screen. */ #define NAME_INCRATOM "figdispincr" /* The name of the incremental atom */ #define NAME_DATAATOM "figdispdata" /* The name of the data atom */ #define NAME_SELATOM "figdispsel" /* The name of the selection atom */ /* The command tokens */ #define RESET 0 /* reset the server. Does not clear either */ /* the line or bitmap graphics screens. Sets */ /* the line graphics line characteristics and */ /* the line graphics LUTs to their default */ /* states. */ #define SHOW_LG_WIN 1 /* takes one argument: 0 means hide the line */ /* graphics window, anything else means show */ /* the line graphics window */ #define SET_LG_LUT 2 /* set the line graphics look up tables. The */ /* first argument is the starting LUT entry, */ /* the next argument is the number of entries */ /* to change, and the remaining arguments are */ /* red, green, and blue (in that order) */ /* values for the LUT entries */ #define LG_CURS 3 /* set and return the line graphics cursor */ /* location. The first argument is the */ /* number of pixels from the left side of the */ /* image. The second is the number of pixels */ /* from the top of the screen. Once a key */ /* has been pressed or a mouse button */ /* clicked, three short elements are */ /* returned. The first two are the position */ /* of the cursor. The third element is the */ /* key or button that was pressed. The high */ /* byte is 0 if a key was pressed and non- */ /* zero if a button was clicked. If a button */ /* was pressed the second byte is the number */ /* of the button which was pressed, from left */ /* to right with 0 being the left-most */ /* button. If a key was pressed the second */ /* byte is the ASCII code of the */ /* corresponding character. */ #define SET_LG_COL 4 /* set the color index for the line graphics */ /* The only argument is the color index to */ /* use. Only the lower 4 bits of the */ /* argument are relevant. */ #define DRAW_LINE 5 /* draw a line from the position specified */ /* by the x and y coordinates of the first */ /* points and the x and y coordinates of the */ /* second point. */ #define DRAW_POLY 6 /* draw a poly-line. The first argument is */ /* the number of points. The remaining */ /* arguments are X,Y pairs in the format of */ /* the DRAW_LINE command. */ #define CLR_LG_WIN 7 /* clear the line graphics window */ #define LG_MAX_DIM 8 /* Get the line graphics window maximum */ /* This returns all information required for */ /* OPCODE 2 in PGPLOT. The first four */ /* elements the minimum and maximum x values */ /* and the mimumum and maximum y values. The */ /* next two elements are the minimum and */ /* maximum allowed color indices */ #define LG_SCALE 9 /* Returns information required for OPCODE 3 */ /* in PGPLOT. The elements are the width and */ /* height of the screen in millimeters and */ /* The width and height of the screen in */ /* pixels. */ #define LG_DEF_SIZE 10 /* Returns the default display size, which is */ /* the current window size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the window. */ #define SET_LG_SIZE 11 /* Sets the size of the line graphics window. */ /* The arguments to this command are the new */ /* x and y sizes. If they exceed the */ /* compile-time maximums or are less than the */ /* compile-time minimums the compile time */ /* values are used instead. */ #define DRAW_DOT 12 /* draw a dot at the specified X,Y location. */ #define FILL_POLY 13 /* Draw a filled polygon. The first argument */ /* is the number of points in the polygon. */ /* The remaining arguments are the X,Y */ /* points. */ #define FILL_RECT 14 /* Draw a filled retangle. The first two */ /* arguments are the X,Y coordinates of the */ /* lower left point and the next two points */ /* are the X,Y coordinates of the upper right */ /* point. */ #define LG_LINE_WID 15 /* set the line width. The argument is the */ /* number of pixels the line width should be */ #define SHOW_BM_WIN 16 /* takes one argument: 0 means hide the */ /* bitmap graphics window, anything else */ /* means show the bitmap graphics window */ #define SET_BM_LUT 17 /* set the bitmap graphics look up tables. */ /* The first argument is the number of bits */ /* used to number the LUT entries (e.g. 8 if */ /* there are 256 LUT entries and 16 if there */ /* are 65536 LUT entries. The next */ /* arguments are the starting LUT entry, the */ /* number of entries to change, and the */ /* fourth argument is a bitfield representing */ /* the LUTs to change. If the fourth */ /* argument is 0 than the all the LUTs are */ /* affected and the remaining arguments are */ /* red, green, and blue (in that order) */ /* values for the LUT entries. If the fourth */ /* argument is 1 than only the red values are */ /* affected, if it is 2 than the green values */ /* are affected, and if it is 4 than the blue */ /* values are affected. If it is a */ /* combination of 1, 2, and 4 than each of */ /* values is used for all appropriate LUTs. */ /* For example, if the sequence was 3 */ /* followed by 15 than both the red and green */ /* LUT values would be set to 15. Note that */ /* this is very different from the */ /* interpretation of SET_LG_LUT. */ #define BM_SET_CURS 18 /* Set the current cursor location. This has */ /* no visible effect until BM_GET_CURS */ /* is sent, when the window is raied and the */ /* pointer is warped to the appropriate */ /* place. Takes two arguments, the X and Y */ /* coordinates of the cursor. */ #define BM_GET_CURS 19 /* return the bitmap graphics cursor */ /* location. The return values are the same */ /* as LG_CURS. */ #define CLR_BM_WIN 20 /* clear the bitmap graphics window */ #define BM_MAX_DIM 21 /* Get the bitmap graphics window maximum */ /* The first four elements the minimum and */ /* maximum x values and the mimumum and */ /* maximum y values. The next two elements */ /* are the minimum and maximum allowed color */ /* indices */ #define BM_DEF_SIZE 22 /* Returns the default display size, which is */ /* the current image size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the image. */ #define SET_BM_SIZE 23 /* Sets the size of the bitmap graphics */ /* window. The arguments to this command are */ /* the new x and y sizes and the new number */ /* of bits in a pixel (8 or 16). If they */ /* exceed the compile-time maximums or are */ /* less than the compile-time minimums the */ /* compile time values are used instead. */ #define BM_WRITE 24 /* write a bitmap to the bitmap image. This */ /* command takes a varying number of */ /* arguments. The first argument is the */ /* number of bits in a pixel (8 or 16). The */ /* next two arguments are the X and Y */ /* coordinates of the upper left corner of */ /* the area to be affected. The next two */ /* arguments are the width and height of the */ /* affected area. The remaining arguments */ /* are the data values. If there are 8 bits */ /* per pixels the data values are all chars. */ /* If the data for this command is split up */ /* between more than one X transfers, than */ /* all but the last transfer must have an */ /* even number of bytes. The last transfer */ /* may have an odd number if necessary. Note */ /* this this is automatically taken care of */ /* if there are 16 bits per pixel. */ #define SET_BM_CSCALE 25 /* Set the X and Y scaling and offset values */ /* so that the built-in cursor can be used. */ /* The arguments to this command are the x */ /* multiplier, the x divisor, the x offset, */ /* the y multiplier, the y divisor, and the */ /* y offset. See the documentation for */ /* further details */ /* scaling factors and adding the offsets. */ #define SET_BM_DSCALE 26 /* Set the data scaling and offset values */ /* so that the built-in cursor can be used. */ /* This command takes two ASCII strings as */ /* arguments, both NULL terminated and in the */ /* %g format (from printf). They are the */ /* scaling factor and the offset to apply to */ /* the data. See the documentation for */ /* further details. */ #define BM_ZOOMPAN 27 /* Set the zoom factor. The first two */ /* arguments are the X and Y coordinates for */ /* the new center of the displayed portion, */ /* and the next two arguments are the power */ /* of two for X & Y to zoom to. Setting the */ /* X or Y coordinate (or both) to -1 leaves */ /* the center of the displayed image as is. */ /* Setting either of the the zoom factors to */ /* a value greater than 30 leaves them as is. */ #define BM_FLUSH 28 /* flush all commands to the screen */ #define BM_LINE 29 /* Draw a line in the bitmap graphics area. */ /* The arguments to this command are the */ /* number of bits per pixel used for the */ /* data value, X & Y coordinates of the two */ /* points (x1, y1, x2, y2) followed by the */ /* data value (0-255 or 0-65535) to use to */ /* draw the line. */ #define LG_PIXLINE 30 /* Draw a line of pixels into the line */ /* graphics windows (PGPLOT opcode 26). The */ /* arguments to this command are the number */ /* of pixels, the starting X and Y */ /* coordinates, and the list of pixels */ #define SET_LG_CSCALE 31 /* Set the line graphics cursor scale so that */ /* the built-in cursor can be used. The four */ /* arguments to this command are the NULL- */ /* terminated ASCII strings in the %g format */ /* (see printf). They are the X offset and */ /* scaling factor followed by the Y values. */ /* See the documentation for further details. */ #define SET_BM_SH_SIZE 32 /* Sets the size of the bitmap graphics */ /* window and uses data from a shared memory */ /* buffer. The arguments to this command are */ /* the new x and y sizes, the new number of */ /* bits in a pixel (8 or 16), the type of */ /* shared memory to use, and a variable */ /* number of other parameters, depending on */ /* the type of shared memory being used. The */ /* shared memory type is very system */ /* dependant. So far the following types, */ /* with the mentioned arguments, are */ /* defined: */ /* Type 1: SunOS 4.1.2 shmget-type. */ /* This type has an extra two argument, the */ /* high 16-bit word of the shared memory */ /* identifier suitable for use with the shmat */ /* call and the low 16-bit word. This */ /* command also returns a two parameter */ /* buffer, the first word of which is */ /* SET_BM_SH_SIZE and the second of which is */ /* 1 if the shared memory mapping was */ /* successful and 0 if it was not. If this */ /* command is not successful, the SET_BM_SIZE */ /* command should be used. See the */ /* programmer's manual for more information */ /* on this command. */ #define BM_SH_UPDATE 33 /* This command tells figdisp to update */ /* internal structures (such as windows) */ /* based on the changed contents of the */ /* shared memory area from SET_BM_SH_SIZE. */ /* The first two arguments are the X and Y */ /* coordinates of the upper left corner of */ /* the area to be affected. The next two */ /* arguments are the width and height of the */ /* affected area. This command is a shared */ /* memory version of the BM_WRITE command and */ /* only works after a SET_BM_SH_SIZE command */ /* has completed successfully since the last */ /* time the the SET_BM_SIZE command was used */ /* (it is ignored otherwise). The BM_WRITE */ /* command may also be used with shared */ /* memory images, but it is not as fast. */ #define DO_BOX 34 /* Compute image statistics within the user */ /* defined rectangle. This command has no */ /* arguments. */ #define DO_AUTODISP 35 /* Linear ramp between percantile range. The */ /* arguments to this command are the two */ /* ASCII strings, the lower and upper bounds */ /* percentiles (between 0.0 and 100.0) to be */ /* used to scale data. */ #define DO_HISTEQ 36 /* Histogram Equalization */ #define FIGDISP_IDLE 37 /* This command returns itself when figdisp */ /* is idle. It is useful for synchronizing */ /* commands, such as CLR_BM_WIN and BM_LINE, */ /* which cause the figdisp program to alter */ /* the image data. If this is not used when */ /* shared memory is in use, the image could */ /* get corrupted. */ #define FIGDISP_POINTS 38 /* This command takes the number of points, */ /* then the number of bits per pixel, then */ /* numpoints triplets of x, y, and value. */ #endif /* INC_COMMANDS_H */ _DEF_SIZE 10 /* Returns the default display size, which is */ /* the current window size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the window. */ #define SET_LG_SIZE 11 /* Sets the size of the line graphics window. */ /* The arguments to this command are the new */ /* x and y sizes. If they exceed the */ /* compile-time maximums or are less than the */ /* compipgplot/drivers/figdisp_comm.c010064400040640000322000000442430666035362400170350ustar00tjpcitmbr00000400000017/* This file contains the routines used by the TVPCKG and PGPLOT libraries to */ /* access the figdisp display server. */ /* Sam Southard, Jr. */ /* Created: 18-Sep-1991 (from figdisp_xxx.c) */ /* 20-Sep-1991 SNS/CIT figdisp_maxbuflen added. */ /* 14-Feb-1992 SNS/CIT Now includes support for multiple devices */ /* 23-Sep-1992 SNS/CIT Now allows for the server running on a machine with a */ /* different byte order. */ /* 27-Sep-1992 SNS/CIT SET_LG_CSCALE now uses ASCII strings. */ /* 23-Nov-1992 SNS/CIT Now uses XSetErrorHandler so that we don't just go */ /* away. */ /* 3-Jun-1994 TJP/CIT Create selection atom if it doesn't exist. */ /* The program include files */ #include "commands.h" /* The system include files */ #include /* Get ntohs prototype or macro */ #ifndef VMS #include #include #endif /* The X Window include files */ #include #include /* Other include files */ #ifdef VMS #include /* for system() */ #include /* for sleep() */ #endif static Display *display; /* the display we're using */ static int screen; /* the screen we're using */ static Window window; /* the window for receiving events */ static Window dispowner; /* the owner of this display */ static Atom incratom; /* the incremental transfer atom */ static Atom sel,targ,prop; /* the atoms used in communications */ static Atom selatom; /* The selection atom */ static Atom lockatom; /* The atom used for locking */ static int maxlen; /* the maximum number of shorts in a transfer */ static int fd_dispopen=0; /* if the display connection is open */ static int xerror=0; /* an X error occurred. */ #ifdef VMS static unsigned short ntohs(netshort) unsigned short netshort; { unsigned short retval; retval = (netshort >> 8) | ((netshort & 0xFF) << 8); return (retval); } #define htons ntohs #endif /* The xerrorhandler routine handles an X error. All it does is set the */ /* xerror flag to true, reset fd_dispopen. , and print an error message. */ static int xerrorhandler (disp, err) Display *disp; XErrorEvent *err; { xerror = 1; fd_dispopen = 0; fprintf(stderr, "Error on X event stream!\n"); return 0; } /* The sendcommand routine sends the specified command buffer piece by piece */ /* until the entire buffer has been sent */ /* Sam Southard, Jr. */ /* Created: 12-Nov-1990 */ /* 16-Nov-1990 SNS/CIT Now takes a buffer of shorts (instead of chars). */ /* 13-Sep-1991 SNS/CIT Now uses "global" display, window, and incratom */ /* 23-Sep-1992 SNS/CIT Now converts the buffer to network order as needed. */ void figdisp_sendcommand(buffer,len) short *buffer; /* the command buffer */ int len; /* number of shorts in the command buffer */ { XEvent event; /* the received event */ XEvent sendevent; /* the outgoing event */ int itmp; /* a temporary integer */ void figdisp_convbufout(); if (!fd_dispopen) return; /* convert the buffer to network byte order */ figdisp_convbufout(buffer,len); while (len && fd_dispopen) { XNextEvent(display,&event); switch(event.type) { case PropertyNotify: /* he wants some more */ /* if it's not a delete, ignore it */ if (event.xproperty.state != PropertyDelete) break; itmp=((len > maxlen) ? maxlen*2 : len*2); XChangeProperty(display,event.xproperty.window,prop, XA_STRING,8,PropModeAppend, (unsigned char *)buffer,itmp); len -= itmp>>1; buffer += itmp>>1; sendevent.xselection.type=SelectionNotify; sendevent.xselection.selection=sel; sendevent.xselection.target=targ; sendevent.xselection.property=prop; sendevent.xselection.time=CurrentTime; (void)XSendEvent(display,dispowner,True,0L,&sendevent); break; } } XFlush(display); return; } /* The figdisp_getresponse routine waits for a response from the */ /* Figaro/PGPLOT display server and returns it to the calling routine */ /* Sam Southard, Jr. */ /* Created: 19-Nov-1990 */ /* 13-Sep-1991 SNS/CIT Now uses "global" display, window, and selatom */ /* 24-Sep-1992 SNS/CIT Now converts the buffer back from network byte order. */ short *figdisp_getresponse(len) int *len; /* the number of shorts in the response */ { XEvent event; /* for the X events */ short *retval; /* the return value */ Atom acttype; /* the actual type of the message */ int actform; /* the actual format of the message */ unsigned long bytesleft; /* the number of bytes left */ unsigned long nitems; /* number of items in value */ void figdisp_convbufin(); while(fd_dispopen && !xerror) { XMaskEvent(display,PropertyChangeMask,&event); if (event.xproperty.atom == selatom && event.xproperty.state == PropertyNewValue) { if (XGetWindowProperty(display,window,selatom,0L,10L, True,AnyPropertyType,&acttype,&actform,&nitems, &bytesleft,(unsigned char **)&retval) != Success) { *len=0; retval=(short *)NULL; } else { if (bytesleft) printf("OOPS - there was data left!\n"); /* we're dealing with shorts */ *len = nitems>>1; } break; } } if (xerror || !fd_dispopen) { *len = 0; retval = NULL; } else { figdisp_convbufin(retval, *len); } return(retval); } /* The figdisp_closecomm routine closes the link with the server */ /* Sam Southard, Jr. */ /* Created: 20-Nov-1990 */ /* 13-Sep-1991 SNS/CIT Now uses static display and window */ /* 6-Nov-1994 MCS/TJP Change uninitialized pointer to 0 */ void figdisp_closecomm() { XEvent event; /* recevied event */ XEvent sendevent; /* send event */ int more=1; int sent=0; if (!fd_dispopen) return; while (more) { XNextEvent(display,&event); switch(event.type) { case PropertyNotify: if (event.xproperty.state != PropertyDelete || sent) break; XChangeProperty(display,event.xproperty.window,prop, incratom,8,PropModeAppend, (unsigned char *)0, 0); sendevent.xselection.type=SelectionNotify; sendevent.xselection.selection=sel; sendevent.xselection.target=targ; sendevent.xselection.property=prop; sendevent.xselection.time=CurrentTime; (void)XSendEvent(display,dispowner,True,0L,&sendevent); sent=1; break; case SelectionClear: /* the server's grabbed the icon */ if (event.xselectionclear.selection == selatom) more=0; break; } } /* get rid of the X stuff */ XDestroyWindow(display,window); XCloseDisplay(display); fd_dispopen=0; return; } /* The figdisp_opencomm routine opens a channel to the display server. */ /* Maxbuf is the maxmimum number of shorts in the command buffer that will */ /* be sent at one time. */ /* Return Value: */ /* 1 Success */ /* 0 Failure */ /* Sam Southard, Jr. */ /* Created: 13-Sep-1991 */ /* Modification History: */ /* 14-Feb-1992 SNS/CIT Now includes support for multiple devices */ int figdisp_opencomm(maxbuf,dev) int maxbuf; int dev; /* The figdisp display to open */ { XEvent event; /* the received event */ XEvent sendevent; /* the outgoing event */ char lockname[40]; /* the name of the locking atom */ if (!fd_dispopen) { if ((display=XOpenDisplay((char *)0)) == NULL) { (void)printf("Couldn't open display!\n"); return(0); } maxlen= (XMaxRequestSize(display)-10)*2; /* we need something to work with */ if (maxlen <= 0) maxlen=1000; screen=DefaultScreen(display); (void)sprintf(&lockname[0],"%s_%d_%d",NAME_SELATOM,screen,dev); if ((selatom=XInternAtom(display,&lockname[0],False)) == None) { (void)printf("Can't find the selection atom!\n"); return(0); } (void)sprintf(&lockname[0],"%s_%d_%d",NAME_INCRATOM,screen,dev); if ((incratom=XInternAtom(display,&lockname[0],False)) == None) { (void)printf("Can't find the incremental atom!\n"); return(0); } /* we need a window to receive events */ window=XCreateSimpleWindow(display, RootWindow(display,screen), 1, 1, 1, 1, 1, BlackPixel(display,screen), WhitePixel(display,screen)); (void)sprintf(&lockname[0],"%s_%d_%d",NAME_PROG,screen,dev); if ((lockatom=XInternAtom(display,&lockname[0],False)) == None) (void)printf("Can't find the locking atom!\n"); else { if (XGetSelectionOwner(display,selatom) == None) { (void)printf("Attempting to start server\n"); sprintf(&lockname[0],"figdisp -id %d &",dev); system(&lockname[0]); /* give it time */ sleep(3); if (XGetSelectionOwner(display,selatom) == None) { (void)printf( "No display server running!\n"); return(0); } } if (XGetSelectionOwner(display,selatom) != XGetSelectionOwner(display,lockatom) && XGetSelectionOwner(display,selatom) != window || XGetSelectionOwner(display,selatom) == None) { (void)printf("Someone's using the display!\n"); return(0); } } XSetSelectionOwner(display,selatom,window,CurrentTime); if (XGetSelectionOwner(display,selatom) != window) { (void)printf("Couldn't own selection atom!\n"); return(0); } XSelectInput(display,window,PropertyChangeMask); /* set up the data link */ while(1) { XNextEvent(display,&event); if (event.type == SelectionRequest) { XSetSelectionOwner(display, event.xselectionrequest.property,window, event.xselectionrequest.time); if (XGetSelectionOwner(display, event.xselectionrequest.property) != window) { (void)printf("can't own property!\n"); return(0); } dispowner=event.xselectionrequest.requestor; XChangeProperty(display,window, event.xselectionrequest.property, incratom,32,PropModeAppend, (unsigned char *)&maxbuf,1); sel=event.xselectionrequest.selection; targ=event.xselectionrequest.target; prop=event.xselectionrequest.property; sendevent.xselection.type=SelectionNotify; sendevent.xselection.selection= event.xselectionrequest.selection; sendevent.xselection.target= event.xselectionrequest.target; sendevent.xselection.property= event.xselectionrequest.property; sendevent.xselection.time= event.xselectionrequest.time; (void)XSendEvent(display,dispowner,True,0L, &sendevent); break; } } XSetErrorHandler (xerrorhandler); fd_dispopen=1; xerror=0; } return(1); } /* The figdisp_maxbuflen routine returns the maximum number of shorts that */ /* can be in a single data transfer between the display server and a client */ /* Return values: */ /* -1 An error occured */ /* else the number of shorts in the maximum transfer */ /* Sam Southard, Jr. */ /* Created: 20-Sep-1991 */ int figdisp_maxbuflen() { Display *tmp=display; /* necessary only if the display isn't open */ int retval; if (!fd_dispopen) { if ((tmp = XOpenDisplay((char *)0)) == NULL) { printf("Could not open display!\n"); return(-1); } } /* allow a little breathing space */ retval= (XMaxRequestSize(tmp) - 10)*2; if (!fd_dispopen) XCloseDisplay(tmp); if (retval <= 0) return(-1); else return(retval); } /* The figdisp_convbufout routine converts the command buffer to the network */ /* byte order. */ /* Sam Southard, Jr. */ /* Created: 23-Sep-1992 */ void figdisp_convbufout(buf, len) unsigned short *buf; /* The command buffer to convert */ int len; /* The number of shorts in the command buffer. */ { unsigned short testshort=0x1234; unsigned short realcom; /* we may be able to skip this */ if (testshort == htons(testshort)) return; /* we have to work at it */ while(len > 0) { realcom = *buf; *buf = htons(*buf); ++buf; --len; switch(realcom) { /* this first set of parameters takes 6 parameters. It */ /* falls through to the lower cases */ /* six parameters */ case SET_BM_CSCALE: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* five parameters */ case BM_LINE: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* four parameters */ case DRAW_LINE: case FILL_RECT: case BM_ZOOMPAN: case BM_SH_UPDATE: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* three parameters */ case SET_BM_SIZE: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* two parameters */ case LG_CURS: case SET_LG_SIZE: case DRAW_DOT: case BM_SET_CURS: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* one parameter */ case SHOW_LG_WIN: case SET_LG_COL: case LG_LINE_WID: case SHOW_BM_WIN: if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; --len; /* This set takes no parameters, so nothing more need be done */ case RESET: case CLR_LG_WIN: case LG_MAX_DIM: case LG_SCALE: case LG_DEF_SIZE: case BM_GET_CURS: case CLR_BM_WIN: case BM_MAX_DIM: case BM_DEF_SIZE: case BM_FLUSH: break; /* A variable number of parameters, each handled individually */ case SET_LG_LUT: { int nluts; if (len < 2) { printf("Incomplete command %d detected!\n", realcom); return; } *buf = htons(*buf); ++buf; nluts = *buf; *buf = htons(*buf); ++buf; nluts *= 3; if (len < nluts+2) { printf("Incomplete command %d detected!\n", realcom); return; } len -= (nluts+2); while(nluts-- > 0) { *buf = htons(*buf); ++buf; } } break; case DRAW_POLY: case FILL_POLY: { int npts; if (len < 1) { printf("Incomplete command %d detected!\n", realcom); return; } npts = *buf; *buf = htons(*buf); ++buf; npts *= 2; if (len < npts+1) { printf("Incomplete command %d detected!\n", realcom); return; } len -= (npts+1); while (npts-- > 0) { *buf = htons(*buf); ++buf; } } break; case SET_BM_LUT: { int nluts,affluts; if (len < 4) { printf("Incomplete command %d detected!\n", realcom); return; } /* starting LUT */ *buf = htons(*buf); ++buf; /* bits per pixel */ *buf = htons(*buf); ++buf; /* number of luts */ nluts = *buf; *buf = htons(*buf); ++buf; affluts = *buf & 0x7; *buf = htons(*buf); ++buf; len -= 4; if (!affluts) nluts *= 3; if (len < nluts) { printf("Incomplete command %d detected!\n", realcom); return; } len -= nluts; while (nluts-- > 0) { *buf = htons(*buf); ++buf; } } break; case BM_WRITE: { int bppix,npix; if (len < 6) { printf("Incomplete command %d detected!\n", realcom); return; } bppix = *buf; *buf = htons(*buf); ++buf; /* startx */ *buf = htons(*buf); ++buf; /* start y */ *buf = htons(*buf); ++buf; npix = *buf; *buf = htons(*buf); ++buf; npix *= *buf; *buf = htons(*buf); ++buf; len -= 5; if (bppix == 16 && len < npix || len < (npix+1)/2) { printf("Incomplete command %d detected!\n", realcom); return; } if (bppix == 16) { len -= npix; while (npix-- > 0) { *buf = htons(*buf); ++buf; } } else { len -= (npix+1)/2; buf += (npix+1)/2; } break; } case SET_BM_DSCALE: { char *cbuf= (char *)buf; int i=0; int nnul=0; while (nnul < 2 && i++ < len*2) { if (*cbuf++ == '\0') ++nnul; } if (nnul < 2) { printf("Incomplete command %d detected!\n", realcom); return; } buf += (i+1)/2; len -= (i+1)/2; } break; case LG_PIXLINE: { int npix; if (len < 4) { printf("Incomplete command %d detected!\n", realcom); return; } npix = *buf; *buf = htons(*buf); ++buf; /* X & Y coords */ *buf = htons(*buf); ++buf; *buf = htons(*buf); ++buf; len -= 3; if (len < npix) { printf("Incomplete command %d detected!\n", realcom); return; } len -= npix; while (npix-- > 0) { *buf = htons(*buf); ++buf; } } break; case SET_LG_CSCALE: { char *cbuf= (char *)buf; int i=0; int nnul=0; while (nnul < 4 && i++ < len*2) { if (*cbuf++ == '\0') ++nnul; } if (nnul < 4) { printf("Incomplete command %d detected!\n", realcom); return; } buf += (i+1)/2; len -= (i+1)/2; } break; case SET_BM_SH_SIZE: { int type; if (len < 5) { printf("Incomplete command %d detected!\n", realcom); return; } for (type=0 ; type < 3 ; ++type) { *buf = htons(*buf); ++buf; } type = *buf; *buf = htons(*buf); buf++; len -= 4; /* note that these will onyl be relevant if they are */ /* on the exact same system, so we don't need to */ /* switch anythign else around, we just need to know */ /* how much to skip */ switch(type) { /* only case currently known is 1, the Sun version */ case 1: if (len < 2) { printf("Incomplete command %d detected!\n", realcom); return; } else { *buf = htons(*buf); ++buf; *buf = htons(*buf); ++buf; len -= 2; } } } break; default: printf("Unknown command %d detected!\n", realcom); break; } } return; } /* The figdisp_convbufin routine converts the response from the network */ /* byte order. */ /* Sam Southard, Jr. */ /* Created: 23-Sep-1992 */ void figdisp_convbufin(buf, len) unsigned short *buf; /* The command buffer to convert */ int len; /* The number of shorts in the command buffer. */ { unsigned short testshort=0x1234; unsigned short realcom; /* we may be able to skip this */ if (testshort == htons(testshort)) return; /* only one response is allowed per buffer */ *buf = ntohs(*buf); switch(*buf++) { /* six arguments */ case LG_MAX_DIM: case BM_MAX_DIM: *buf = ntohs(*buf); ++buf; /* five arguments */ *buf = ntohs(*buf); ++buf; /* four arguments */ case LG_SCALE: case LG_DEF_SIZE: case BM_DEF_SIZE: *buf = ntohs(*buf); ++buf; /* three arguments */ case LG_CURS: case BM_GET_CURS: *buf = ntohs(*buf); ++buf; /* two arguments */ *buf = ntohs(*buf); ++buf; /* one argument */ case SET_BM_SH_SIZE: *buf = ntohs(*buf); ++buf; break; default: printf("Unknown return buffer %d detected!\n", *(buf-1)); break; } return; } pgplot/drivers/pgxwin_server.c010064400040640000322000003211760640736042600172770ustar00tjpcitmbr00000400000017#ifndef _POSIX_SOURCE #define _POSIX_SOURCE #endif #include #include #include #include #include #include #include #include #include #include #include /* * The following headers are included to define the setpgid() prototype. */ #ifndef VMS #include #include #include #endif /* * Client/server communication protocol revision number. */ #define PGXWIN_REVISION 0 /* * Allow the expose-event handler name to be changed by compile * time pre-definition of PGXWIN_SERVER. If pgxwin_server is modified in * such a way as to become incompatible with an earlier version of xwdriv.c, * its name should be changed by postfixing a small increasing integer * to the name of the executable. New and old pgplot programs can then * coexist as long as both versions of the server are * retained. In order not to clutter up system directories, don't change * this name unless absolutely necessary. This is also the name given to * the server selection atom, so be sure that it remains valid for this * purpose. */ #ifndef PGXWIN_SERVER #define PGXWIN_SERVER "pgxwin_server" #endif #define XW_MAX_COLORS 256 /* Max number of colors to allocate */ /* Note that the line_of_pixels opcode */ /* assumes that there are at most 256 colors */ #define XW_MIN_COLORS 2 /* Min number of colors per colormap */ #define XW_DEF_COLORS 100 /* Default number of colors to allocate */ #define NCOLORS 16 /* Number of pre-defined PGPLOT colors */ #define XW_IMAGE_LEN 1280 /* Length of the line-of-pixels buffer */ #define COLORMULT 65535 /* Normalized color intensity multiplier */ #define XW_DEV_NAME "XWINDOW (X Window display)" /* PGPLOT device name */ #define XW_WINDOW_NAME "PGPLOT Window" /* Window title */ #define XW_ICON_NAME "PGPLOT" /* Name to place under the icon */ #define XW_BORDER ((unsigned int)4) /* Window border width (pixels) */ #define XW_DEF_ASPECT (8.5/11.0) /* Default aspect (height/width) of window */ #define XW_DEF_WIDTH 867 /* Default width (pixels) */ #define XW_DEF_HEIGHT ((int) XW_DEF_WIDTH * XW_DEF_ASPECT) /* Default height (pixels) */ #define XW_MIN_WIDTH 64 /* Minimum width (pixels) */ #define XW_MIN_HEIGHT 64 /* Minimum height (pixels) */ /* * Define equivalence values for the XParseGeometry bitmask bits, using * values agreed upon by xwdriv.c and pgxwin_server.c, for use in * communicating geometries between client and server. */ #define XW_WidthValue 1 #define XW_HeightValue 2 #define XW_XValue 4 #define XW_YValue 8 #define XW_XNegative 16 #define XW_YNegative 32 /* * Enumerate the supported window close-down modes. */ #define XW_DELETE 1 #define XW_PERSIST 2 #define XW_ICONIZE 3 /* * Enumerate property-data formats, named after the internal types that * are used to communicate them with XChangeProperty() and * XGetWindowProperty(). */ #define XW_CHAR_PROP 8 #define XW_SHORT_PROP 16 #define XW_LONG_PROP 32 /* * ANSI defines two exit value to indicate succesful and unsuccesful program * termination. We should use these. On pre-ANSI machines we will assume * the old K&R convention. */ #ifndef EXIT_SUCCESS #define EXIT_SUCCESS 0 #endif #ifndef EXIT_FAILURE #define EXIT_FAILURE 1 #endif /* A container used to record the geometry of the X-window */ typedef struct { int x,y; /* Locus of top left corner of window (pixels) */ unsigned int width; /* Width of window (pixels) */ unsigned int height; /* Height of window (pixels) */ int xpix_per_inch; /* Number of pixels per inch along X */ int ypix_per_inch; /* Number of pixels per inch along Y */ int xmargin; /* X-axis 1/4" margin in pixels */ int ymargin; /* Y-axis 1/4" margin in pixels */ int xmin,xmax; /* Min/max X-axis pixels excluding 1/4" margins */ int ymin,ymax; /* Min/max X-axis pixels excluding 1/4" margins */ } XWgeom; /* * Declare a colormap descriptor. */ typedef struct { XVisualInfo *vi; /* The colormap visual information descriptor */ Colormap cmap; /* Colormap ID */ int ncol; /* The number of colors available. ci = [0...ncol-1] */ unsigned long *pixel; /* Color pixels allocated */ int monochrome; /* True we have to use a monochrome screen */ int default_class; /* The class of the default visual of the screen */ } XWcolor; /* Declare a container for cursor IDs */ typedef struct { Cursor norm; /* ID of cursor to use when cursor input is not expected */ Cursor live; /* ID of cursor to use when cursor input is expected */ Cursor idle; /* ID of cursor to use when the window is un-assigned */ } XWCursor; /* Declare a container in which to record resource database quarks */ typedef struct { /* A Quark name/class resource pair */ XrmQuark name; XrmQuark class; } XWQPair; typedef struct { XWQPair prog; /* Program name/class quarks */ XWQPair display; /* .display name/class quarks */ XWQPair server; /* .server. name/class quark */ XWQPair geom; /* PGWin geometry name/class quarks */ XWQPair iconize; /* PGWin iconize name/class quarks */ XWQPair acceptquit; /* PGWin acceptQuit name/class quarks */ XWQPair mincolors; /* PGWin minColors name/class quarks */ XWQPair maxcolors; /* PGWin maxColors name/class quarks */ XWQPair visual; /* PGWin visual name/class quarks */ XWQPair crosshair; /* PGWin crosshair name/class quarks */ XWQPair visible; /* Server visible name/class quarks */ XWQPair icongeom; /* iconGeometry name/class quarks */ XrmQuark win_class; /* PGWin window-specification class quark */ } XWQuarks; /* Declare a container to record details of a given client window */ typedef struct PGwin { Window window; /* PGPLOT /xw window ID */ Window parent; /* Parent window of 'window' */ Window client; /* Window ID of client using the window */ Pixmap pixmap; /* Pixmap ID for buffering and expose-event handling */ GC gc; /* Graphical context descriptor */ int protocol; /* Client/server protocol revision to use */ int id; /* PGPLOT selection ID */ int screen; /* The screen on which the window appears */ int mapped; /* True only after the window is first mapped */ int disposition; /* Close-down mode: XW_PERSIST, XW_ICONIZE, XW_DELETE */ int acceptquit; /* True if WM_DELETE_WINDOW events are to be obeyed on */ /* Active windows */ int iconize; /* If true, iconize inactive windows if persistent */ int mincol; /* Min number of colors per colormap */ int maxcol; /* Max number of colors per colormap */ int crosshair; /* If true show crosshair cursor */ int visual_class; /* If != -1, then this is the visual class to try for. */ XWgeom geom; /* The size and position of the window */ XWcolor color; /* Colormap descriptor */ XWCursor *curs; /* Pointer to xw->col_cursor or xw->gry_cursor */ struct PGwin *next;/* Pointer to next window in list */ } PGwin; /* Declare a container for server data */ typedef struct { Display *display; /* Connection to the display */ XrmDatabase xrdb; /* X resource database */ int screen; /* Screen number of windows */ Window pgxwin; /* ID of top-level window of server */ Atom server_atom; /* PGXWIN_SERVER selection atom */ Atom client_data; /* PGXWIN_CLIENT_DATA property atom */ PGwin *active_list; /* LIFO list of active PGPLOT /xw windows */ PGwin *closed_list; /* Sorted list of un-connected PGPLOT /xw windows */ XWCursor col_cursor;/* Cursors for color visuals */ XWCursor gry_cursor;/* Cursors for gray and monochrome visuals */ XWQuarks quarks; /* Resource database quarks */ Pixmap icon; /* ID of icon pixmap */ Atom wm_protocols; /* WM_PROTOCOLS atom */ Atom wm_delete_win; /* WM_DELETE_WINDOW atom */ Atom geom_atom; /* Client/server geometry transaction atom */ } XWServer; #ifdef __STDC__ #define ARGS(args) args #else #define ARGS(args) () #endif static XWServer *new_XWServer ARGS((XrmDatabase xrdb)); static XWServer *del_XWServer ARGS((XWServer *xw)); static PGwin *new_PGwin ARGS((XWServer *xw, int id, int screen, Window client, int disposition)); static PGwin *add_PGwin ARGS((PGwin **pglist, int sort, PGwin *pgw)); static PGwin *rem_PGwin ARGS((PGwin **pglist, PGwin *pgw)); static PGwin *del_PGwin ARGS((XWServer *xw, PGwin *pgw)); static Window xw_server_window ARGS((XWServer *xw)); static int xw_set_signals ARGS((void)); static int xw_handle_error ARGS((Display *display, XErrorEvent *event)); static int xw_event_loop ARGS((XWServer *xw)); static Bool xw_parse_bool ARGS((char *str, Bool def)); static int xw_parse_visual ARGS((char *str)); static int xw_same_string ARGS((char *s1, char *s2)); static int xw_client_message ARGS((XWServer *xw, XEvent *event)); static int xw_ret_cursor ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_ret_colors ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_ret_error ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_new_window ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_new_pixmap ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_set_geom ARGS((XWServer *xw, PGwin *pgw, int x, int y, unsigned int width, unsigned int height, int mask)); static int xw_new_geom ARGS((XWServer *xw, XEvent *event, PGwin *pgw)); static int xw_get_geom ARGS((XWServer *xw, PGwin *pgw)); static int xw_wm_message ARGS((XWServer *xw, XEvent *event)); static int xw_check_destroy ARGS((XWServer *xw, XEvent *event)); static int xw_expose_win ARGS((XWServer *xw, XEvent *event)); static int xw_get_visual ARGS((XWServer *xw, PGwin *pgw)); static int xw_find_visual ARGS((XWServer *xw, PGwin *pgw, int class)); static int xw_get_colorcells ARGS((XWServer *xw, PGwin *pgw, XVisualInfo *vi, Colormap cmap)); static int xw_del_Colormap ARGS((XWServer *xw, PGwin *pgw, XVisualInfo *vi, Colormap cmap, int ncol)); static XVisualInfo *xw_visual_info ARGS((Display *display, int screen, Visual *visual)); static int xw_prep_window ARGS((XWServer *xw, PGwin *pgw, Window client, int protocol)); static unsigned long xw_send_data ARGS((XWServer *xw, PGwin *pgw, unsigned char *data, int form, unsigned long n, Atom type)); static int xw_ini_cursors ARGS((XWServer *xw, XWCursor *curs)); static int xw_new_cursors ARGS((XWServer *xw, int usecolor, XWCursor *curs)); static int xw_del_cursors ARGS((XWServer *xw, XWCursor *curs)); static char *xw_home_dir ARGS((void)); static XrmDatabase xw_get_xrdb ARGS((Display *display, XrmDatabase cmd_xrdb)); static int xw_get_quarks ARGS((XWServer *xw)); static char *xw_get_default ARGS((XWServer *xw, int window_id, XWQPair *pair)); static int xw_get_config ARGS((XWServer *xw, PGwin *pgw)); static int xw_setwmhints ARGS((XWServer *xw, int screen, Window window,int id)); static int xw_name_window ARGS((XWServer *xw, Window window, char *w_name, char *i_name)); static int xw_sync_error ARGS((XWServer *xw)); /* List resource command-line arguments */ static XrmOptionDescRec cmd_opt[] = { {"-display", ".server.display", XrmoptionSepArg, NULL}, {"-win_visual", ".Win.visual", XrmoptionSepArg, NULL}, {"-win_iconize", ".Win.iconize", XrmoptionSepArg, NULL}, {"-win_geometry", ".Win.geometry", XrmoptionSepArg, NULL}, {"-win_minColors", ".Win.minColors", XrmoptionSepArg, NULL}, {"-win_maxColors", ".Win.maxColors", XrmoptionSepArg, NULL}, {"-win_crosshair", ".Win.crosshair", XrmoptionSepArg, NULL}, {"-win_acceptQuit", ".Win.acceptQuit", XrmoptionSepArg, NULL}, {"-win_iconGeometry", ".Win.iconGeometry",XrmoptionSepArg, NULL}, {"-server_visible", ".server.visible", XrmoptionSepArg, NULL}, {"-server_iconGeometry",".server.iconGeometry", XrmoptionSepArg, NULL}, {"-xrm", NULL, XrmoptionResArg, NULL} }; /* List usage of command-line arguments */ static struct { char *opt; char *arg; } cmd_usage[] = { {"-help", ""}, {"-display", "display_name"}, {"-win_visual", "default|monochrome|pseudocolor|directcolor|staticcolor|truecolor|grayscale|staticgray"}, {"-win_iconize", "True|False"}, {"-win_geometry", "WIDTHxHEIGHT+X+Y"}, {"-win_minColors", "integer"}, {"-win_maxColors", "integer"}, {"-win_crosshair", "True|False"}, {"-win_acceptQuit", "True|False"}, {"-win_iconGeometry", "+X+Y"}, {"-server_visible", "True|False"}, {"-server_iconGeometry","+X+Y"}, {"-xrm", "Resource manager string, eg. \"pgxwin.win2.maxColors: 16\""} }; /*....................................................................... * PGPLOT /xw driver multi-client window server. * * Input: * argv[1] char * The name of the display to connect to. */ #ifdef __STDC__ int main(int argc, char *argv[]) #else int main(argc, argv) int argc; char *argv[]; #endif { XWServer *xw; /* PGPLOT /xw server descriptor */ XrmDatabase cmd_xrdb=NULL; /* Command-line X resource database */ int i; /* * Close stdin and stdout since we aren't going to use them. */ fclose(stdin); fclose(stdout); /* * Under UNIX make sure that we are not in the same process group as * the process that spawned us. Otherwise, signals sent to the parent * will be sent to us as well. */ #ifndef VMS setpgid(0,0); #endif /* * Reset signal handlers. */ xw_set_signals(); /* * Get command-line X resource options. */ XrmInitialize(); XrmParseCommand(&cmd_xrdb, cmd_opt, (int)(sizeof(cmd_opt)/sizeof(XrmOptionDescRec)), "pgxwin", &argc, argv); /* * The only legal remaining argument is -help. */ if(argc > 1) { if(strcmp(argv[1],"-help")!=0) { fprintf(stderr, "%s: Unknown command-line option \"%s\". Try the -help option.\n", PGXWIN_SERVER, argv[1]); } else { fprintf(stderr, "Usage:\n\t %s [options]\n\n", PGXWIN_SERVER); fprintf(stderr, "Where legal options and their arguments include:\n"); for(i=0; idisplay = NULL; xw->xrdb = xrdb; xw->screen = 0; xw->pgxwin = None; xw->server_atom = None; xw->client_data = None; xw->active_list = NULL; xw->closed_list = NULL; xw_ini_cursors(xw, &xw->col_cursor); xw_ini_cursors(xw, &xw->gry_cursor); xw->icon = None; xw->wm_protocols = None; xw->wm_delete_win = None; xw->geom_atom = None; /* * Initialize the list of resource database quarks required by xw_get_config(). */ if(xw_get_quarks(xw)) return del_XWServer(xw); /* * Determine the display name. */ display_name = xw_get_default(xw, 0, &xw->quarks.display); /* * Open a connection to the display. */ if((xw->display = XOpenDisplay(display_name)) == NULL) { fprintf(stderr, "%s: cannot connect to X server [%s]\n", PGXWIN_SERVER, XDisplayName(display_name)); return del_XWServer(xw); }; /* * Get the X resource database for the display, combined with the * command-line database. */ xw->xrdb = xw_get_xrdb(xw->display, xw->xrdb); /* * Get the screen number referenced in the display name. */ xw->screen = DefaultScreen(xw->display); /* * Install an error handler for non-fatal errors. If we don't do this then * Xlib will do its own error handling, which includes killing the program. */ XSetErrorHandler(xw_handle_error); /* * Get selected window-manager atoms. */ xw->wm_protocols = XInternAtom(xw->display, "WM_PROTOCOLS", False); xw->wm_delete_win = XInternAtom(xw->display, "WM_DELETE_WINDOW", False); /* * Get the window geometry client/server transaction atom. */ xw->geom_atom = XInternAtom(xw->display, "PGXWIN_GEOMETRY", False); /* * Create a simple unmapped window to receive events on. */ xw->pgxwin = xw_server_window(xw); if(xw->pgxwin==None) return del_XWServer(xw); /* * Get the server selection atom. */ xw->server_atom = XInternAtom(xw->display, PGXWIN_SERVER, False); if(xw->server_atom == None) { fprintf(stderr, "%s: Failed to obtain %s selection atom.\n", PGXWIN_SERVER, PGXWIN_SERVER); return del_XWServer(xw); }; /* * See if another server already exists by checking if the PGXWIN_SERVER * selection is currently owned by another window. */ if(XGetSelectionOwner(xw->display, xw->server_atom) != None) { fprintf(stderr, "%s: Another server is already active.\n", PGXWIN_SERVER); return del_XWServer(xw); }; /* * Grab ownership of the PGXWIN_SERVER selection. */ XSetSelectionOwner(xw->display, xw->server_atom, xw->pgxwin, CurrentTime); XFlush(xw->display); /* * Did another server beat us to it? */ if(XGetSelectionOwner(xw->display, xw->server_atom) != xw->pgxwin) { fprintf(stderr, "%s: Another server is already active.\n", PGXWIN_SERVER); return del_XWServer(xw); }; /* * Get the client data property atom. */ xw->client_data = XInternAtom(xw->display, "PGXWIN_CLIENT_DATA", False); if(xw->client_data == None) { fprintf(stderr, "%s: Failed to obtain PGXWIN_CLIENT_DATA selection atom.\n", PGXWIN_SERVER); return del_XWServer(xw); }; /* * Create two cursors to be used by clients. The normal cursor is used * when cursor input is not expected, and the live cursor is used when * input is expected. Allocate two versions or these cursors - one for * color visuals and another for gray/monochrome displays. */ if(xw_new_cursors(xw, 1, &xw->col_cursor) || xw_new_cursors(xw, 0, &xw->gry_cursor)) return del_XWServer(xw); return xw; } /*....................................................................... * Clean up, and delete a XWServer descriptor. * * Input: * xw XWServer * The server descriptor to be deleted. * Output: * return XWServer * Allways NULL. */ #ifdef __STDC__ static XWServer *del_XWServer(XWServer *xw) #else static XWServer *del_XWServer(xw) XWServer *xw; #endif { if(xw) { /* * Display connection acquired? */ if(xw->display) { /* * Delete the communication window. * This will also clear the ownership of the PGXWIN_SERVER selection. */ if(xw->pgxwin != None) XDestroyWindow(xw->display, xw->pgxwin); /* * Delete all client windows. */ while(xw->active_list) del_PGwin(xw, rem_PGwin(&xw->active_list, xw->active_list)); while(xw->closed_list) del_PGwin(xw, rem_PGwin(&xw->closed_list, xw->closed_list)); /* * Delete the cursors. */ xw_del_cursors(xw, &xw->col_cursor); xw_del_cursors(xw, &xw->gry_cursor); /* * Delete the icon pixmap. */ if(xw->icon != None) XFreePixmap(xw->display, xw->icon); /* * Close the connection to the display. */ XCloseDisplay(xw->display); }; /* * Delete the empty container. */ free((char *)xw); }; return NULL; } /*....................................................................... * Create and display the server window in its iconic state. * * Input: * xw XWServer * The descriptor of the server. * Only the 'display', 'screen' and 'wm_delete_window' * members are used. * Output: * return Window The ID of the server window, or None on error. */ #ifdef __STDC__ static Window xw_server_window(XWServer *xw) #else static Window xw_server_window(xw) XWServer *xw; #endif { Window window = None; /* The new server window */ unsigned int width = 200; /* The width of the window when mapped */ unsigned int height = 20; /* The height of the window when mapped */ int x = 0; /* The X-position of the window when mapped */ int y = 0; /* The Y-position of the window when mapped */ /* * Create the window. Bracket the window acquisition with * xw_sync_error() calls, to determine whether any window creation * errors occur. */ xw_sync_error(xw); window = XCreateSimpleWindow(xw->display, DefaultRootWindow(xw->display), x, y, width, height, (unsigned)1, WhitePixel(xw->display, xw->screen), BlackPixel(xw->display, xw->screen)); if(xw_sync_error(xw) || window==None) { fprintf(stderr, "%s: Failed to create the PGPLOT server window.\n", PGXWIN_SERVER); return None; }; /* * Name the server window and its icon. */ if(xw_name_window(xw, window, "PGPLOT Server", "pgxwin")) { XDestroyWindow(xw->display, window); return None; }; /* * Tell the window manager how to dimension and locate the window. */ { XSizeHints *hints = XAllocSizeHints(); if(!hints) { fprintf(stderr, "%s: Insufficient memory.\n", PGXWIN_SERVER); XDestroyWindow(xw->display, window); return None; }; hints->flags = PPosition | PSize; hints->x = x; hints->y = y; hints->width = width; hints->height = height; XSetWMNormalHints(xw->display, window, hints); XFree((char *)hints); }; /* * Set window manager hints to tell the window manager that the * initial state of the window when mapped, should be iconic. */ if(xw_setwmhints(xw, xw->screen, window, 0)) { XDestroyWindow(xw->display, window); return None; }; /* * Arrange to be informed of window manager "delete window" actions. */ XSetWMProtocols(xw->display, window, &xw->wm_delete_win, 1); /* * Display the server window if requested. */ { char *def = xw_get_default(xw, 0, &xw->quarks.visible); if(xw_parse_bool(def, True) == True) XMapWindow(xw->display, window); }; XFlush(xw->display); return window; } /*....................................................................... * Remove a PGPLOT /xw window from a given list of windows. * * Input: * pglist Pgwins ** Pointer to the head of the window list. * pgw PGwin * The descriptor of the window to be deleted. * Output: * return PGwin * The descriptor of the removed window, or NULL * if not found. */ #ifdef __STDC__ static PGwin *rem_PGwin(PGwin **pglist, PGwin *pgw) #else static PGwin *rem_PGwin(pglist, pgw) PGwin **pglist; PGwin *pgw; #endif { PGwin *prev; /* Descriptor of window before current position in list */ PGwin *next; /* Descriptor of next window to be checked */ /* * Search for the location of the window on the xw->pgwins list. */ prev = NULL; next = *pglist; while(next!=NULL && next!=pgw) { prev = next; next = next->next; }; /* * Window not found? */ if(next==NULL) { fprintf(stderr, "%s(rem_PGwin): No such window.\n", PGXWIN_SERVER); return NULL; }; /* * Relink around the window. */ if(prev==NULL) *pglist = next->next; else prev->next = next->next; /* * The descriptor is no longer in a list. */ next->next = NULL; /* * Return the window descriptor. */ return next; } /*....................................................................... * Add a PGPLOT /xw window to a given list of windows. The window is * is inserted such that the list is maintained in order of window * number. * * Input: * pglist Pgwins ** Pointer to the head of the window list. * sort int If true, insert the window such that a list sorted * in order of increasing pgw->number is maintained * in that order. Otherwise insert at the head of * the list to implement a LIFO list. * pgw PGwin * The descriptor of the window to be added. * Output: * return PGwin * The descriptor of the added window. */ #ifdef __STDC__ static PGwin *add_PGwin(PGwin **pglist, int sort, PGwin *pgw) #else static PGwin *add_PGwin(pglist, sort, pgw) PGwin **pglist; int sort; PGwin *pgw; #endif { PGwin *prev; /* Pointer to previous window in list */ PGwin *next; /* Pointer to next window in list */ if(pgw==NULL) { fprintf(stderr, "%s(add_PGwin): NULL window descriptor.\n", PGXWIN_SERVER); return NULL; }; /* * Maintain a sorted list? */ if(sort) { /* * Find the correct position for the window in the window list. */ prev = NULL; next = *pglist; while(next && next->id < pgw->id) { prev = next; next = next->next; }; /* * Insert the window between 'prev' and 'next'. */ pgw->next = next; if(prev==NULL) *pglist = pgw; else prev->next = pgw; /* * To implement a LIFO list, insert the window at the head of the list. */ } else { pgw->next = *pglist; *pglist = pgw; }; return pgw; } /*....................................................................... * Delete a PGPLOT /xw window. Note that if the descriptor comes from * a list of windows, it must first be removed from the list by * rem_PGwin(). * * Input: * xw XWServer * The descriptor of the server. * pgw PGwin * The descriptor of the window to be deleted. * Output: * return PGwin * Allways NULL. */ #ifdef __STDC__ static PGwin *del_PGwin(XWServer *xw, PGwin *pgw) #else static PGwin *del_PGwin(xw, pgw) XWServer *xw; PGwin *pgw; #endif { if(pgw) { /* * Remove the PGPLOT window from the display. */ if(pgw->window != None) XUnmapWindow(xw->display, pgw->window); /* * Destroy the graphical context descriptor. */ if(pgw->gc) XFreeGC(xw->display, pgw->gc); /* * Delete the colormap, any private color cells and the visual info descriptor. */ if(pgw->color.vi) { xw_del_Colormap(xw, pgw, pgw->color.vi, pgw->color.cmap, pgw->color.ncol); XFree((char *)pgw->color.vi); pgw->color.vi = NULL; }; /* * Delete the array of pixel indexes. */ if(pgw->color.pixel) free((char *)pgw->color.pixel); /* * Destroy the PGPLOT /xw window. */ if(pgw->window != None) XDestroyWindow(xw->display, pgw->window); /* * Destroy its pixmap. */ if(pgw->pixmap != None) XFreePixmap(xw->display, pgw->pixmap); /* * Delete the container. */ free((char *)pgw); }; return NULL; } /*....................................................................... * Set up signal handlers. */ #ifdef __STDC__ static int xw_set_signals(void) #else static int xw_set_signals() #endif { signal(SIGINT, SIG_DFL); /* * We shouldn't be receiving any alarms, but just in case we do, arrange * to ignore them. */ #ifdef SIGALRM signal(SIGALRM, SIG_IGN); #endif #ifdef SIGTSTP signal(SIGTSTP, SIG_DFL); #endif signal(SIGTERM, SIG_DFL); signal(SIGFPE, SIG_DFL); #ifdef SIGABRT signal(SIGABRT, SIG_DFL); #endif #ifdef SIGQUIT signal(SIGQUIT, SIG_DFL); #endif /* * We have arranged for this process to be a process group leader, * and the only process in its group (to avoid receiving signals sent to * the process that created it). POSIX.1 says that if such a process is * orphaned when in a stopped state, the process will be sent SIGHUP * followed by SIGCONT. Arrange to ignore the SIGHUP. */ #ifdef SIGHUP signal(SIGHUP, SIG_IGN); #endif #ifdef SIGPOLL signal(SIGPOLL, SIG_DFL); #endif return 0; } /*....................................................................... * This function is called by X whenever a non-fatal error occurs * on a given display connection. For the moment it does nothing but * count such errors in an internal static error counter. This counter * can then be queried and reset by sending a NULL error event pointer. * * Input: * display Display * The display connection on which the error occured. * event XErrorEvent * The descriptor of the error event, or NULL to * request that the error counter be queried and reset. * Output: * return int The return value is not specified by Xlib, so * for Xlib calls we will simply return 0. For * none Xlib calls (distinguishable by sending * event==NULL), the value of the error counter * is returned. */ #ifdef __STDC__ static int xw_handle_error(Display *display, XErrorEvent *event) #else static int xw_handle_error(display, event) Display *display; XErrorEvent *event; #endif { static int error_count = 0; /* * To query and reset the error counter, this program calls xw_handle_error() * with a NULL error event pointer. This distinguishes it from a call * from Xlib. */ if(!event) { int ret_count = error_count; error_count = 0; /* Reset the error counter */ return ret_count; /* Return the pre-reset value of the error counter */ #ifdef DEBUG } else { char errtxt[81]; /* Buffer to receive error message in */ /* * Get a message describing the error. */ XGetErrorText(display, (int)event->error_code, errtxt, (int)sizeof(errtxt)); fprintf(stderr, "%s: XErrorEvent: %s\n", PGXWIN_SERVER, errtxt); /* * Report the operation that caused it. These opcode numbers are listed in * . */ fprintf(stderr, "%s: Major opcode: %d, Resource ID: 0x%lx%s.\n", PGXWIN_SERVER, (int) event->request_code, (unsigned long) event->resourceid, (event->resourceid==DefaultRootWindow(display)?" (Root window)":"")); #endif }; /* * Keep a record of the number of errors that have occurred since the * error counter was last cleared. */ error_count++; return 0; } /*....................................................................... * This is the main server event loop, which listens for client events * on client windows and the main event window. It returns only on * server shutdown. * * Input: * xw XWServer * The server descriptor. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_event_loop(XWServer *xw) #else static int xw_event_loop(xw) XWServer *xw; #endif { XEvent event; /* The descriptor of the lastest X-event */ int have_selection=1; /* If the server selection is stolen set this to 0 */ /* * Enter the event loop. */ do { XNextEvent(xw->display, &event); switch(event.type) { /* * Handle client-server messages. */ case ClientMessage: if(event.xclient.message_type == xw->wm_protocols) { if(xw_wm_message(xw, &event)) return 0; } else { if(xw_client_message(xw, &event)) return 0; }; break; /* * Has somebody else grabbed the selection atom? */ case SelectionClear: fprintf(stderr, "%s: Server selection usurped.\n", PGXWIN_SERVER); have_selection = 0; break; /* * Refuse all selection requests. */ case SelectionRequest: { XEvent reply; reply.xselection.type = SelectionNotify; reply.xselection.requestor = event.xselectionrequest.requestor; reply.xselection.selection = event.xselectionrequest.selection; reply.xselection.target = event.xselectionrequest.target; reply.xselection.time = event.xselectionrequest.time; reply.xselection.property = None; XSendEvent(xw->display, event.xselection.requestor, False, (long)0, &reply); }; break; /* * Handle window exposure events. */ case Expose: if(xw_expose_win(xw, &event)) return 0; break; /* * Watch for client windows being destroyed. */ case DestroyNotify: if(xw_check_destroy(xw, &event)) return 0; break; default: break; }; /* * Quit if the selection atom has been stolen and no clients are connected. */ } while(have_selection || xw->closed_list!=NULL); return 0; } /*....................................................................... * Handle messages sent to the server by PGPLOT /xw clients. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * Output: * return int 0 - OK. * 1 - Close server. */ #ifdef __STDC__ static int xw_client_message(XWServer *xw, XEvent *event) #else static int xw_client_message(xw, event) XWServer *xw; XEvent *event; #endif { Window client; /* Source client window */ PGwin *pgw; /* Descriptor of the associated PGPLOT window */ /* * The window argument contains the window of the client that sent the * event. */ client = event->xclient.window; /* * New window required? */ if(event->xclient.message_type == XA_WINDOW) { xw_new_window(xw, event, (PGwin *)0); } else { /* * Locate the descriptor of the PGPLOT /xw window that is connected to * the client (or NULL if not yet connected). */ for(pgw=xw->active_list; pgw && pgw->client!=client; pgw=pgw->next); /* * Handle the specified message type. */ if(pgw) { Atom type = event->xclient.message_type; switch(type) { case XA_PIXMAP: xw_new_pixmap(xw, event, pgw); break; case XA_CURSOR: xw_ret_cursor(xw, event, pgw); break; case XA_COLORMAP: xw_ret_colors(xw, event, pgw); break; default: if(type == xw->geom_atom) xw_new_geom(xw, event, pgw); else xw_ret_error(xw, event, pgw); /* Unknown message type */ break; }; }; }; return 0; } /*....................................................................... * Reply to a client that has requested the IDs of the normal and active * cursors. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_ret_cursor(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_ret_cursor(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { /* * Assign the cursor IDs to the return message descriptor. */ event->xclient.data.l[0] = pgw->curs->norm; event->xclient.data.l[1] = pgw->curs->live; event->xclient.data.l[2] = pgw->crosshair; if(!XSendEvent(xw->display, pgw->client, False, (long)0, event)) return 1; XFlush(xw->display); return 0; } /*....................................................................... * Reply to a client that has requested an unknown message type by * returning a message with the message_type field set to None. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window (or NULL * if this is not known). * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_ret_error(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_ret_error(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { event->xclient.message_type = None; if(!XSendEvent(xw->display, event->xclient.window, False, (long)0, event)) return 1; XFlush(xw->display); return 0; } /*....................................................................... * Reply to a client that has requested colormap details. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_ret_colors(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_ret_colors(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { /* * Assign the colormap attributes to the return message descriptor. */ event->xclient.data.l[0] = pgw->color.cmap; event->xclient.data.l[1] = pgw->color.ncol; if(!XSendEvent(xw->display, pgw->client, False, (long)0, event)) return 1; XFlush(xw->display); /* * If any colors were allocated, send the client the colormap pixel * indexes by placing them in the PGXWIN_CLIENT_DATA property on the * client's communication window. */ if(pgw->color.cmap != None && xw_send_data(xw, pgw, (unsigned char *)&pgw->color.pixel[0], XW_LONG_PROP, (unsigned long)pgw->color.ncol, XA_INTEGER)==0) return 1; return 0; } /*....................................................................... * Respond to a client request for a new window. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_new_window(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_new_window(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { int protocol = event->xclient.data.l[0];/* Protocol revision */ int id = event->xclient.data.l[1]; /* Window number requested */ int screen = event->xclient.data.l[2]; /* Screen to put window on */ int disposition = event->xclient.data.l[3]; /* Close-down disposition */ Window client = event->xclient.window; /* Client communication window */ /* * Limit the requested communication protocol to one that we can handle. */ if(protocol > PGXWIN_REVISION) protocol = PGXWIN_REVISION; /* * Treat -ve window ids as equivalent to the 0 wildcard. */ if(id<0) id = 0; /* * New window required? */ if(pgw==NULL) { /* * See if the request can be satisfied by a currently unassigned * window. */ if(xw->closed_list != NULL) { /* * Use the first window if no particular number has been requested. */ if(id==0) id = xw->closed_list->id; /* * Search for a window that has the required numeric id. */ for(pgw=xw->closed_list; pgw && pgw->id != id; pgw=pgw->next); /* * If found, remove the window from the inactive list and register * it to the new client. */ if(pgw) { rem_PGwin(&xw->closed_list, pgw); pgw->client = client; }; }; /* * If a window with the required ID was found, but it is displayed on * a different screen than the client now wants, destroy it so that a * new window of the requested ID can be created on the specified screen. */ if(pgw && pgw->screen != screen) pgw = del_PGwin(xw, pgw); /* * Create a new window? */ if(pgw==NULL) { /* * Determine an unused window number if no number was specified. * Note that the window list is arranged in increasing order * of window number. */ if(id==0) { PGwin *tmpwin = xw->active_list; for(id=1; tmpwin && tmpwin->id==id; tmpwin=tmpwin->next,id++); }; /* * See if the requested ID is already in use. */ for(pgw=xw->active_list; pgw && pgw->id != id; pgw=pgw->next); /* * If the required id is not in use create a new window. */ pgw = pgw ? NULL : new_PGwin(xw, id, screen, client, disposition); }; /* * If a new window was acquired, add it to the active list and prepare it * for use. If during preparing the new client window, it turns out to have * been destroyed, return the PGPLOT window to the inactive list. */ if(pgw) { if(xw_prep_window(xw, pgw, client, protocol)) { add_PGwin(&xw->closed_list, 0, pgw); pgw = NULL; }; }; }; /* * If a window was assigned to the new client record its details in * the return client-message descriptor. */ if(pgw && pgw->client == client) { event->xclient.data.l[0] = pgw->protocol; event->xclient.data.l[1] = pgw->id; event->xclient.data.l[2] = pgw->window; event->xclient.data.l[3] = pgw->disposition; } else { event->xclient.data.l[0] = protocol; event->xclient.data.l[1] = 0; event->xclient.data.l[2] = None; /* No window available */ event->xclient.data.l[3] = 0; }; if(!XSendEvent(xw->display, client, False, (long)0, event)) return 1; XFlush(xw->display); return 0; } /*....................................................................... * Set and return the window geometry. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_new_geom(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_new_geom(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { int x = event->xclient.data.l[0]; int y = event->xclient.data.l[1]; unsigned int width = event->xclient.data.l[2]; unsigned int height = event->xclient.data.l[3]; int xw_mask = event->xclient.data.l[4]; int mask = 0; /* XParseGeometry() bit-mask */ /* * Translate from the PGXWIN defined bitmap values to the local * XParseGeometry() bitmap values. */ if(xw_mask & XW_WidthValue) mask |= WidthValue; if(xw_mask & XW_HeightValue) mask |= HeightValue; if(xw_mask & XW_XValue) mask |= XValue; if(xw_mask & XW_YValue) mask |= YValue; if(xw_mask & XW_XNegative) mask |= XNegative; if(xw_mask & XW_YNegative) mask |= YNegative; /* * Install the new geometry in the pgw->geom descriptor. */ xw_set_geom(xw, pgw, x,y, width,height, mask); /* * Update the window-manager size hints for the current window. */ { XSizeHints *hints = XAllocSizeHints(); if(hints) { hints->flags = USPosition | USSize | PMinSize; hints->x = pgw->geom.x; hints->y = pgw->geom.y; hints->width = pgw->geom.width; hints->height = pgw->geom.height; hints->min_width = XW_MIN_WIDTH; hints->min_height = XW_MIN_HEIGHT; /* * Instate the new size hints in the WM_NORMAL_HINTS property. */ XSetWMNormalHints(xw->display, pgw->window, hints); XFree((char *)hints); }; }; /* * Resize the window if requested. */ if(mask & (WidthValue | HeightValue)) XResizeWindow(xw->display, pgw->window, pgw->geom.width, pgw->geom.height); /* * Move the window if requested. */ if(mask & (XValue | YValue)) XMoveWindow(xw->display, pgw->window, pgw->geom.x, pgw->geom.y); /* * If the window has not previously been mapped, map it now. */ if(!pgw->mapped) { XMapRaised(xw->display, pgw->window); pgw->mapped = 1; }; /* * Return details of the new geometry to the client. */ event->xclient.data.l[0] = pgw->geom.x; event->xclient.data.l[1] = pgw->geom.y; event->xclient.data.l[2] = pgw->geom.width; event->xclient.data.l[3] = pgw->geom.height; if(!XSendEvent(xw->display, pgw->client, False, (long)0, event)) return 1; XFlush(xw->display); return 0; } /*....................................................................... * Respond to a client request for a new pixmap. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * pgw PGwin * Descriptor of the client PGPLOT window. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_new_pixmap(XWServer *xw, XEvent *event, PGwin *pgw) #else static int xw_new_pixmap(xw, event, pgw) XWServer *xw; XEvent *event; PGwin *pgw; #endif { unsigned long fill_pixel = event->xclient.data.l[0]; /* * Delete the current pixmap if it doesn't have the required size. */ if(pgw->pixmap != None) { Window root; int x, y; unsigned width, height, border, depth; /* * Determine the size of the existing pixmap. */ XGetGeometry(xw->display, pgw->pixmap, &root, &x, &y, &width, &height, &border, &depth); /* * If the pixmap doesn't have a size equal to that requested in the last * PGXWIN_GEOMETRY transaction, delete it. */ if(width != pgw->geom.width || height != pgw->geom.height) { XFreePixmap(xw->display, pgw->pixmap); pgw->pixmap = None; }; }; /* * Create a new pixmap if necessary. */ if(pgw->pixmap == None) { /* * Bracket the pixmap acquisition with xw_sync_error() calls, to * determine whether any errors occur. */ xw_sync_error(xw); pgw->pixmap = XCreatePixmap(xw->display, pgw->window, pgw->geom.width, pgw->geom.height, (unsigned) pgw->color.vi->depth); if(xw_sync_error(xw) || pgw->pixmap==None) { fprintf(stderr, "%s: Failed to allocate %dx%d pixmap.\n", PGXWIN_SERVER, pgw->geom.width, pgw->geom.height); pgw->pixmap = None; }; }; /* * Set the fill-color to that specified by the client. */ XSetForeground(xw->display, pgw->gc, fill_pixel); /* * Clear the pixmap. */ if(pgw->pixmap != None) XFillRectangle(xw->display, pgw->pixmap, pgw->gc, 0, 0, pgw->geom.width, pgw->geom.height); /* * Clear the window. */ XClearWindow(xw->display, pgw->window); XFlush(xw->display); /* * Return the ID of the new pixmap and its size. */ event->xclient.data.l[0] = pgw->pixmap; if(!XSendEvent(xw->display, pgw->client, False, (long)0, event)) return 1; XFlush(xw->display); return 0; } /*....................................................................... * Check a resource string value against boolean values. * * Input: * str char * The string value to be tested (NULL is ok). * def Bool The default boolean value to take if the string * matches none of the recognized boolean strings. * Output: * return Bool The boolean value of the string. */ #ifdef __STDC__ static Bool xw_parse_bool(char *str, Bool def) #else static Bool xw_parse_bool(str, def) char *str; Bool def; #endif { /* * Check for truth values. */ if(xw_same_string(str, "true") || xw_same_string(str, "yes") || xw_same_string(str, "t") || xw_same_string(str, "on") || xw_same_string(str, "1")) def = True; /* * Check for false values. */ else if(xw_same_string(str, "false") || xw_same_string(str, "no") || xw_same_string(str, "f") || xw_same_string(str, "off") || xw_same_string(str, "0")) def = False; return def; } /*....................................................................... * Check a resource string value against visual class names. * * Input: * str char * The string value to be tested (NULL is ok). * Output: * return int The Visual class parsed, or -1 to select the default. */ #ifdef __STDC__ static int xw_parse_visual(char *str) #else static int xw_parse_visual(str) char *str; #endif { /* * Create a lookup table of recognised visual classes. */ static struct { char *name; /* Name of visual class */ int class; /* Enumerated identifier of visual class */ } classes[] = { {"monochrome", -2}, {"default", -1}, {"pseudocolor", PseudoColor}, {"directcolor", TrueColor}, /* We can't handle DirectColor */ {"staticcolor", StaticColor}, {"truecolor", TrueColor}, {"grayscale", GrayScale}, {"staticgray", StaticGray} }; int i; /* * Lookup the given class name. */ if(str) { for(i=0; iwindow!=None the * defaults will be those of the current window. The other defaults * use the appropriate combination of XW_DEF_WIDTH and XW_DEF_ASPECT * macros, the optional PGPLOT_XW_WIDTH environment variable and where * positions are not given, the size of the display, used to center the plot. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. Only the display * and screen members are required. * pgw PGwin * The PGPLOT window descriptor. * mask int A bit mask to specify which values have been provided * and how they should be interpretted. The mask is the * union of the following: * WidthValue - Use the given width value. * HeightValue - Use the given height value. * XValue - Use the given value of 'x'. * YValue - Use the given value of 'y'. * XNegative - x is wrt the right of the display. * YNegative - y is wrt the left of the display. * x int The left edge of the window. * y int The top edge of the window. * width unsigned The width of the window. * height unsigned The height of the window. * Output: * pgw->geom XWgeom The new window geometry. * return int 0 - OK. */ #ifdef __STDC__ static int xw_set_geom(XWServer *xw, PGwin *pgw, int x, int y, unsigned int width, unsigned int height, int mask) #else static int xw_set_geom(xw, pgw, x, y, width, height, mask) XWServer *xw; PGwin *pgw; int x; int y; unsigned int width; unsigned int height; int mask; #endif { unsigned int d_pix_width; /* Display width in pixels */ unsigned int d_pix_height; /* Display height in pixels */ unsigned int d_mm_width; /* Display width in mm */ unsigned int d_mm_height; /* DIsplay height in mm */ unsigned int w_width=0; /* Current window width (pixels) */ unsigned int w_height=0; /* Current window height (pixels) */ int w_x; /* Current window x offset (pixels) */ int w_y; /* Current window y offset (pixels) */ /* * Determine the current display width and height in mm and pixels. */ d_pix_width = DisplayWidth(xw->display, pgw->screen); d_mm_width = DisplayWidthMM(xw->display, pgw->screen); d_pix_height = DisplayHeight(xw->display, pgw->screen); d_mm_height = DisplayHeightMM(xw->display, pgw->screen); /* * If the window is already open, get its attributes. */ if(pgw->window != None) { XWindowAttributes attr; /* Current window attributes */ Window child; XGetWindowAttributes(xw->display, pgw->window, &attr); /* * Translate from parent-relative to absolute X and Y window offsets. */ XTranslateCoordinates(xw->display, pgw->window, attr.root, 0, 0, &w_x, &w_y, &child); w_x -= XW_BORDER; w_y -= XW_BORDER; w_width = attr.width; w_height = attr.height; }; /* * Ensure that all given values are positive. */ if((mask & XValue) && x < 0) { mask |= XNegative; x = -x; }; if((mask & YValue) && y < 0) { mask |= YNegative; y = -y; }; /* * Is either the width or height unspecified? */ if(!(mask & WidthValue) || !(mask & HeightValue)) { /* * Width given but not height? */ if(mask & WidthValue) { height = (pgw->window!=None) ? w_height : (int)(width * XW_DEF_ASPECT); /* * Height given but not width? */ } else if(mask & HeightValue) { width = (pgw->window!=None) ? w_width : (int)(height / XW_DEF_ASPECT); } /* * Neither width nor height given? */ else { if(pgw->window != None) { width = w_width; height = w_height; } else { char *envptr; /* * Use the XW_DEF_WIDTH macro to set the default width. */ width = XW_DEF_WIDTH; /* * The user PGPLOT_XW_WIDTH environment variable overrides the default width. */ if((envptr=getenv("PGPLOT_XW_WIDTH")) != NULL) { float frac_width; if(sscanf(envptr, "%f", &frac_width) != 1 || frac_width <= 0.0 || frac_width > 2.0) { fprintf(stderr, "%s: Ignoring bad PGPLOT_XW_WIDTH=\"%s\"\n", PGXWIN_SERVER, envptr); } else { width = (unsigned int) (frac_width * d_pix_width); }; }; /* * Use a hieght given by the default aspect ratio and the default width. */ height = width * XW_DEF_ASPECT; }; }; }; /* * Apply width and height bounds. */ if(width < XW_MIN_WIDTH) width = XW_MIN_WIDTH; if(height < XW_MIN_HEIGHT) height = XW_MIN_HEIGHT; /* * Assign the return width and height values. */ pgw->geom.width = width; pgw->geom.height = height; /* * Determine the horizontal offset of the left edge of the window. */ if(mask & XValue) { pgw->geom.x = (mask & XNegative) ? (d_pix_width - x - pgw->geom.width) : x; if(pgw->geom.x < 0) pgw->geom.x = 0; } else if(pgw->window != None) { pgw->geom.x = w_x; } else { pgw->geom.x = (d_pix_width - pgw->geom.width) / 2; /* Center the window */ }; /* * Determine the vertical offset of the top edge of the window. */ if(mask & YValue) { pgw->geom.y = (mask & YNegative) ?(d_pix_height - y - pgw->geom.height) : y; if(pgw->geom.y < 0) pgw->geom.y = 0; } else if(pgw->window != None) { pgw->geom.y = w_y; } else { pgw->geom.y = (d_pix_height - pgw->geom.height) / 2; /* Center the window */ }; /* * Determine the device resolution in pixels per inch. */ pgw->geom.xpix_per_inch = 25.4 * ((double)d_pix_width / (double)d_mm_width); pgw->geom.ypix_per_inch = 25.4 * ((double)d_pix_height / (double)d_mm_height); /* * Determine the number of pixels needed to form a 1/4" margin around the * the plot area. */ pgw->geom.xmargin = (int) (0.25 * pgw->geom.xpix_per_inch + 0.5); pgw->geom.ymargin = (int) (0.25 * pgw->geom.ypix_per_inch + 0.5); /* * Determine the pixel indexes that enclose an area bounded by 1/4" margins. */ pgw->geom.xmin = pgw->geom.xmargin; pgw->geom.xmax = pgw->geom.width - pgw->geom.xmargin; pgw->geom.ymin = pgw->geom.ymargin; pgw->geom.ymax = pgw->geom.height - pgw->geom.ymargin; return 0; } /*....................................................................... * Determine the default geometry for a new window. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_geom(XWServer *xw, PGwin *pgw) #else static int xw_get_geom(xw, pgw) XWServer *xw; PGwin *pgw; #endif { int x,y; /* The offset of the window on the screen (pixels) */ unsigned int width; /* The width of the window (pixels) */ unsigned int height; /* The height of the window (pixels) */ int mask; /* A bit mask to specify which values are known */ char *geometry; /* The X-default geometry string */ /* * Get the optional pgxwin.geometry: resource string. */ geometry = xw_get_default(xw, pgw->id, &xw->quarks.geom); /* * XParseGeometry() returns values specified in the geometry string and * a mask used to specify which values were found and how they should be * interpretted. If no geometry string was found, specify the mask for * an empty set. */ mask = geometry ? XParseGeometry(geometry, &x, &y, &width, &height) : 0; /* * Send the values and the selection mask to xw_set_geom(). It will fill * in default values for members not marked in the mask. */ return xw_set_geom(xw, pgw, x, y, width, height, mask); } /*....................................................................... * Handle expose-events on client windows. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the expose event. * Output: * return int 0 - OK. * 1 - Close server. */ #ifdef __STDC__ static int xw_expose_win(XWServer *xw, XEvent *event) #else static int xw_expose_win(xw, event) XWServer *xw; XEvent *event; #endif { Window window; /* The window on which the expose event was generated */ PGwin *pgw; /* Descriptor of the connected PGPLOT /xw window */ /* * The window argument contains the window of the client that sent the * event. */ window = event->xexpose.window; /* * Locate the descriptor of the PGPLOT /xw window requiring an update. */ for(pgw=xw->active_list; pgw && pgw->window!=window; pgw=pgw->next); if(pgw==NULL) for(pgw=xw->closed_list; pgw && pgw->window!=window; pgw=pgw->next); /* * If it is one of our windows we have a backing pixmap to repair * the damaged part of the window, copy the exposed area from the * pixmap to the window. */ if(pgw && pgw->pixmap != None) { XCopyArea(xw->display, pgw->pixmap, pgw->window, pgw->gc, event->xexpose.x, event->xexpose.y, (unsigned) event->xexpose.width, (unsigned) event->xexpose.height, event->xexpose.x, event->xexpose.y); XFlush(xw->display); }; return 0; } /*....................................................................... * Handle messages sent to the server by the window manager. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * Output: * return int 0 - OK. * 1 - Close server. */ #ifdef __STDC__ static int xw_wm_message(XWServer *xw, XEvent *event) #else static int xw_wm_message(xw, event) XWServer *xw; XEvent *event; #endif { PGwin *pgw; /* Descriptor of a PGPLOT window */ Window window; /* Window to which the message was sent */ /* * Hopefully the window argument contains the window of the client that * sent the event. My book doesn't say. */ window = event->xclient.window; /* * Handle the specific window-manager message. */ if(event->xclient.data.l[0] == xw->wm_delete_win) { /* Delete window */ /* * Was the message sent to the server window? */ if(window == xw->pgxwin) { /* * Delete inactive windows. */ while(xw->closed_list) del_PGwin(xw, rem_PGwin(&xw->closed_list, xw->closed_list)); /* * If there are no remaining windows the server should be closed down. */ return xw->active_list == NULL; } else { /* * Find out if it is a window from the active list. */ for(pgw=xw->active_list; pgw && pgw->window!=window; pgw=pgw->next); if(pgw) { if(pgw->acceptquit) { XKillClient(xw->display, pgw->client); rem_PGwin(&xw->active_list, pgw); del_PGwin(xw, pgw); } else { pgw->disposition = XW_DELETE; /* Defer deletion until inactive */ }; }; /* * Find out if it is a window from the inactive list. */ for(pgw=xw->closed_list; pgw && pgw->window!=window; pgw=pgw->next); if(pgw) { rem_PGwin(&xw->closed_list, pgw); del_PGwin(xw, pgw); }; }; }; return 0; } /*....................................................................... * Check a DestroyNotify event to see if it came from one of our * client windows. If it did, close the connection to that client. * * Input: * xw XWServer * The server descriptor. * event XEvent * The descriptor of the message. * Output: * return int 0 - OK. * 1 - Close server. */ #ifdef __STDC__ static int xw_check_destroy(XWServer *xw, XEvent *event) #else static int xw_check_destroy(xw, event) XWServer *xw; XEvent *event; #endif { PGwin *pgw; /* Descriptor of the PGPLOT window */ Window window; /* The window wo which the event was sent */ /* * The destroyed window is recorded in the 'window' member. */ window = event->xdestroywindow.window; /* * See if the window is a client of one of the windows managed by us. */ for(pgw=xw->active_list; pgw && pgw->client!=window; pgw=pgw->next); /* * If it was one of our clients, remove its PGPLOT window from the active * list. */ if(pgw) { rem_PGwin(&xw->active_list, pgw); /* * Mark the window as unused by changing the cursor. */ XDefineCursor(xw->display, pgw->window, pgw->curs->idle); /* * If the window should be retained mapped, move it to the inactive * window list. Otherwise delete it. */ if(pgw->disposition == XW_DELETE) { del_PGwin(xw, pgw); } else { add_PGwin(&xw->closed_list, 0, pgw); if(pgw->disposition == XW_ICONIZE) XIconifyWindow(xw->display, pgw->window, pgw->screen); }; /* * See if one of our PGPLOT windows got destroyed by another program. * In principle this shouldn't happen because other programs shouldn't * be deleting resources that we created. Unfortunately there is at * least one program that does do this. The TkSteal program steals * windows from other applications and adds them to the window * hierarchy of a given Tk application. When the Tk program exits * the window then gets destroyed - arrgh! */ } else { /* * Check the list of active windows first. */ for(pgw=xw->active_list; pgw && pgw->window!=window; pgw=pgw->next); if(pgw) { fprintf(stderr, "\n%s: Active PGPLOT window %d destroyed by another program!\n", PGXWIN_SERVER, pgw->id); del_PGwin(xw, rem_PGwin(&xw->active_list, pgw)); /* * Check the list of inactive windows if not found in the active list. */ } else { for(pgw=xw->closed_list; pgw && pgw->window!=window; pgw=pgw->next); if(pgw) del_PGwin(xw, rem_PGwin(&xw->closed_list, pgw)); }; }; return 0; } /*....................................................................... * Create a new PGPLOT window. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * id int The numeric id used by PGPLOT users to refer to the * window. * screen int The screen on which to create the window. * client Window The window ID of the client to which the new window * is to be assigned. * disposition int The close-down mode desired for the window when * the client disconnects: * XW_PERSIST - Keep the window mapped. * XW_ICONIZE - Iconize the window. * XW_DELETE - Delete window. * Output: * return PGwin * The new PGPLOT window descriptor, or NULL on error. */ #ifdef __STDC__ static PGwin *new_PGwin(XWServer *xw, int id, int screen, Window client, int disposition) #else static PGwin *new_PGwin(xw, id, screen, client, disposition) XWServer *xw; int id; int screen; Window client; int disposition; #endif { PGwin *pgw; /* The return descriptor */ /* * Allocate the descriptor. */ pgw = (PGwin *) malloc(sizeof(PGwin)); if(pgw==NULL) { fprintf(stderr, "%s: Insufficient memory for new PGPLOT window.\n", PGXWIN_SERVER); return del_PGwin(xw, pgw); }; /* * Initialize all members of the descriptor at least to the point at which * the descriptor can safely be sent to del_PGwin(). All pointers must * be assigned NULL and XIDs assigned None, so that del_PGwin() knows what * hasn't been allocated yet. */ pgw->window = None; pgw->parent = None; pgw->client = client; pgw->protocol = PGXWIN_REVISION; pgw->pixmap = None; pgw->gc = NULL; pgw->id = id; pgw->screen = screen; pgw->mapped = 0; pgw->disposition = disposition; pgw->color.vi = NULL; pgw->color.cmap = None; pgw->color.ncol = 0; pgw->color.pixel = NULL; pgw->color.monochrome = 1; pgw->color.default_class = 0; pgw->curs = NULL; pgw->next = NULL; /* * Get the configuration defaults for the window. */ if(xw_get_config(xw, pgw)) return del_PGwin(xw, pgw); /* * If a persistent window has been requested, see if it should be iconized * when inactive. */ if(pgw->disposition == XW_PERSIST && pgw->iconize) pgw->disposition = XW_ICONIZE; /* * Record the parent window ID. */ pgw->parent = RootWindow(xw->display, pgw->screen); /* * Get a visual and colormap for the pending window. */ if(xw_get_visual(xw, pgw)) return del_PGwin(xw, pgw); /* * Get the default geometry for the window. */ if(xw_get_geom(xw, pgw)) return del_PGwin(xw, pgw); /* * Get color or black-and-white cursors for the window. */ if(DisplayCells(xw->display, pgw->screen) < 10 || pgw->color.default_class == GrayScale || pgw->color.default_class == StaticGray) { pgw->curs = &xw->gry_cursor; } else { pgw->curs = &xw->col_cursor; }; /* * Create the window. */ { XSetWindowAttributes attr; unsigned long mask = CWEventMask | CWDontPropagate | CWBorderPixel | CWBackPixel | CWCursor; attr.event_mask = ExposureMask | StructureNotifyMask; attr.do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask | KeyPressMask | KeyReleaseMask; attr.border_pixel = WhitePixel(xw->display, pgw->screen); attr.background_pixel = BlackPixel(xw->display, pgw->screen); attr.cursor = pgw->curs->idle; if(!pgw->color.monochrome) { mask |= CWColormap; attr.colormap = pgw->color.cmap; }; /* * Bracket the window acquisition with xw_sync_error() calls, to * determine whether any window creation errors occur. */ xw_sync_error(xw); pgw->window = XCreateWindow(xw->display, pgw->parent, pgw->geom.x, pgw->geom.y, pgw->geom.width, pgw->geom.height, XW_BORDER, pgw->color.vi->depth, InputOutput, pgw->color.vi->visual, mask, &attr); if(xw_sync_error(xw) || pgw->window == None) { fprintf(stderr, "%s: Failed to create window with visual: id=0x%lx class=%d depth=%u.\n", PGXWIN_SERVER, (unsigned long)pgw->color.vi->visualid, pgw->color.vi->class, pgw->color.vi->depth); fprintf(stderr, "%s: Colormap id=0x%lx.\n", PGXWIN_SERVER, (unsigned long) pgw->color.cmap); pgw->window = None; return del_PGwin(xw, pgw); }; }; /* * Arrange to be informed of window manager "delete window" actions. */ XSetWMProtocols(xw->display, pgw->window, &xw->wm_delete_win, 1); /* * Give the window and icon names. */ { char window_name[sizeof(XW_WINDOW_NAME)+10]; char icon_name[sizeof(XW_ICON_NAME)+10]; sprintf(window_name, "%s %d", XW_WINDOW_NAME, pgw->id); sprintf(icon_name, "%s%d", XW_ICON_NAME, pgw->id); if(xw_name_window(xw, pgw->window, window_name, icon_name)) return del_PGwin(xw, pgw); }; /* * Specify window-state hints to the window manager. */ if(xw_setwmhints(xw, pgw->screen, pgw->window, pgw->id)) return del_PGwin(xw, pgw); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ { XGCValues gcv; gcv.graphics_exposures = False; xw_sync_error(xw); pgw->gc = XCreateGC(xw->display, pgw->window, (unsigned long) (GCGraphicsExposures), &gcv); }; if(xw_sync_error(xw) || pgw->gc==NULL) { fprintf(stderr, "%s: Failed to allocate graphical context for window 0x%lx.\n", PGXWIN_SERVER, (unsigned long) pgw->window); return del_PGwin(xw, pgw); }; /* * Return the initialized descriptor for use. */ return pgw; } /*....................................................................... * Set up the visual and colormap for the /xw window. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * Output: * pgw->color.vi The info descriptor of the visual to be used. * pgw->color.cmap The ID of the colormap to use. * pgw->color.ncol The number of colors available. * pgw->color.pixel[0..ncol] The color cell pixel indexes. * pgw->color.monochrome If true, use black and white instead of the above * values. * * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_visual(XWServer *xw, PGwin *pgw) #else static int xw_get_visual(xw, pgw) XWServer *xw; PGwin *pgw; #endif { /* * Initialize the color descriptor. */ pgw->color.vi = NULL; pgw->color.cmap = None; pgw->color.ncol = 2; pgw->color.pixel = NULL; pgw->color.monochrome = 1; pgw->color.default_class = 0; /* * Get the XVisualInfo structure for the default visual. */ pgw->color.vi = xw_visual_info(xw->display, pgw->screen, DefaultVisual(xw->display, pgw->screen)); if(!pgw->color.vi) return 1; /* * Allocate an array to store pixel indexes in. */ pgw->color.pixel=(unsigned long *)malloc(sizeof(unsigned long) * pgw->maxcol); if(pgw->color.pixel==NULL) { fprintf(stderr, "%s: Insufficient memory for new PGPLOT window.\n", PGXWIN_SERVER); return 1; }; /* * Record the class of the default colormap. */ pgw->color.default_class = pgw->color.vi->class; /* * Check for user preferences before starting the default visual search. */ if(pgw->visual_class != -2 && (pgw->visual_class<0 || !xw_find_visual(xw, pgw, pgw->visual_class))) { /* * Color display? */ switch(pgw->color.default_class) { case PseudoColor: case StaticColor: case DirectColor: case TrueColor: if(xw_find_visual(xw, pgw, PseudoColor) || xw_find_visual(xw, pgw, StaticColor) || xw_find_visual(xw, pgw, TrueColor)) return 0; break; /* * Gray-scale display? */ case GrayScale: case StaticGray: if(xw_find_visual(xw, pgw, GrayScale) || xw_find_visual(xw, pgw, StaticGray)) return 0; break; }; }; /* * Use the monochrome default if no usable colormap was found. */ return 0; } /*....................................................................... * Private function of xw_get_visual(), used to find a visual of a given * class and at least pgw->mincol colors. The pgw->color structure will * be left untouched unless a good colormap is located. It is assumed * that pgw->color.vi is initialized with a info structure for the * default visual returned by xw_visual_info(). * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * class int The type of colormap required, chosen from: * PseudoColor,StaticColor,GrayScale,StaticGray. * Input/Output: * * return int 0 - No colormap was found - pgw->color.* remain * at the values that they had on input. * 1 - A suitable colormap was found. The following * members of pgw->color will be set as indicated. * vi - The info descriptor of the located visual. * cmap - The ID of the located colormap. * pixel - The color cell pixel indexes. * ncol - The number of colors available. * Note that the returned colormap and pixels must * be deleted via xw_del_Colormap() and the vi structure * via XFree() when the window is destroyed. */ #ifdef __STDC__ static int xw_find_visual(XWServer *xw, PGwin *pgw, int class) #else static int xw_find_visual(xw, pgw, class) XWServer *xw; PGwin *pgw; int class; #endif { Colormap cmap=None; /* The new colormap */ int ncol=0; /* The number of colors allocated */ XVisualInfo *vi=NULL; /* The visual info of a private colormap */ /* * See if the default (shared) visual supports the required class of * colormap. */ if(class == pgw->color.vi->class) { cmap = DefaultColormap(xw->display, pgw->screen); ncol = xw_get_colorcells(xw, pgw, pgw->color.vi, cmap); if(ncol >= pgw->maxcol) { pgw->color.cmap = cmap; pgw->color.ncol = ncol; pgw->color.monochrome = 0; return 1; }; xw_del_Colormap(xw, pgw, pgw->color.vi, cmap, ncol); }; /* * Acquire a private colormap. */ { XVisualInfo vi_template; /* Visual search template */ XVisualInfo *vi_list = NULL; /* List of matching visuals */ int nmatch; /* Number of matching visuals in vi_list[] */ /* * Get a list of all visuals of the requested class. */ vi_template.class = class; vi_list = XGetVisualInfo(xw->display, (long)VisualClassMask, &vi_template, &nmatch); /* * Search the list for a visual that has a colormap size that * best matches pgw->maxcol. Note that the colormap_size memeber of * the visual info structure effectively provides the number of * "independant" color table entries. Thus the following algorithm * works even for colormaps of TrueColor and DirectColor where the * colormap_size attribute refers to the size of a single primary color * table. */ if(vi_list) { XVisualInfo *vi_below = NULL; XVisualInfo *vi_above = NULL; for(vi=vi_list; vicolormap_size < pgw->maxcol) { if(!vi_below || vi->colormap_size > vi_below->colormap_size) vi_below = vi; } else { if(!vi_above || vi->colormap_size < vi_above->colormap_size) vi_above = vi; }; }; /* * If available, use a visual that has at least pgw->maxcol independant * colors. */ if(vi_above) vi = vi_above; else if(vi_below) vi = vi_below; else vi = NULL; /* * Did we get a usable visual? */ if(vi && vi->colormap_size > 2) vi = xw_visual_info(xw->display, pgw->screen, vi->visual); XFree((char *) vi_list); }; }; /* * Bracket the colormap acquisition with xw_sync_error() calls, to * determine whether any allocation errors occur. */ if(vi) { xw_sync_error(xw); cmap = XCreateColormap(xw->display, pgw->parent, vi->visual, AllocNone); if(xw_sync_error(xw) || cmap == None) { fprintf(stderr, "%s: XCreateColormap failed for visual: id=0x%lx class=%d depth=%u.\n", PGXWIN_SERVER, (unsigned long)vi->visualid, vi->class, vi->depth); /* * Allocate color-cells in the new colormap. */ } else if((ncol = xw_get_colorcells(xw, pgw, vi, cmap)) >= pgw->mincol) { XFree((char *) pgw->color.vi); pgw->color.vi = vi; pgw->color.cmap = cmap; pgw->color.ncol = ncol; pgw->color.monochrome = 0; #ifdef DEBUG fprintf(stderr, "%s: Got %d colors in colormap 0x%lx, visual id=0x%lx class=%d depth=%u.\n", PGXWIN_SERVER, ncol, (unsigned long)cmap, (unsigned long) vi->visualid, vi->class, vi->depth); #endif return 1; } else { xw_del_Colormap(xw, pgw, vi, cmap, ncol); }; XFree((char *) vi); }; /* * Failed to get a colormap of the requested class. */ return 0; } /*....................................................................... * Private function of xw_find_visual(), used to allocate color cells for a * given colormap and return a count of the number allocated. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * vi XVisualInfo * The info descripto of the visual containing the colormap. * cmap Colormap The colormap ID to associate the cells with. * Output: * pgw->color.pixel[] The colorcell indexes. * return int The number of colors allocated. */ #ifdef __STDC__ static int xw_get_colorcells(XWServer *xw, PGwin *pgw, XVisualInfo *vi, Colormap cmap) #else static int xw_get_colorcells(xw, pgw, vi, cmap) XWServer *xw; PGwin *pgw; XVisualInfo *vi; Colormap cmap; #endif { unsigned long maxcol; /* The max number of cells to attempt to allocate */ int ncol; /* The number of color-cells allocated */ /* * Determine the number of color cells in the colormap. */ switch(vi->class) { case PseudoColor: case GrayScale: case StaticColor: case StaticGray: maxcol = vi->colormap_size; break; case TrueColor: case DirectColor: /* * Determine the maximum number of significant colors available * by looking at the total number of bits set in the pixel bit-masks. */ maxcol = 1; { unsigned long rgb_mask = (vi->red_mask | vi->green_mask | vi->blue_mask); do { if(rgb_mask & (unsigned long)0x1) maxcol <<= (unsigned long)1; } while(maxcol < pgw->maxcol && (rgb_mask >>= (unsigned long)1) != 0); }; break; default: maxcol = 0; break; }; /* * Limit the number of colorcells to the size of the pgw->color.pixel[] array. */ if(maxcol > pgw->maxcol) maxcol = pgw->maxcol; /* * Don't try to allocate anything if there are too few colors available. */ if(maxcol < pgw->mincol) { ncol = 0; } else { unsigned long planes[1]; unsigned int nplanes = 0; /* * Dynamic colormaps require one to allocate cells explicitly. * Allocate up to maxcol color cells. */ switch(vi->class) { case PseudoColor: case GrayScale: case DirectColor: /* * See if we can get all of the colors requested. */ if(XAllocColorCells(xw->display, cmap, False, planes, nplanes, pgw->color.pixel, (unsigned) maxcol)) { ncol = maxcol; /* * If there aren't at least pgw->mincol color cells available, then * give up on this colormap. */ } else if(!XAllocColorCells(xw->display, cmap, False, planes, nplanes, pgw->color.pixel, (unsigned) pgw->mincol)) { ncol = 0; } else { /* * Since we were able to allocate pgw->mincol cells, we may be able to * allocate more. First discard the pgw->mincol cells, so that we can * try for a bigger number. */ XFreeColors(xw->display, cmap, pgw->color.pixel, (int) pgw->mincol, (unsigned long)0); /* * Since there is no direct method to determine the number of allocatable * color cells available in a colormap, perform a binary search for the * max number that can be allocated. Note that it is possible that another * client may allocate colors from the same colormap while we search. This * invalidates the result of the search and is the reason for the outer * while loop. */ ncol = 0; do { int lo = pgw->mincol; int hi = maxcol; while(lo<=hi) { int mid = (lo+hi)/2; if(XAllocColorCells(xw->display, cmap, False, planes, nplanes, pgw->color.pixel, (unsigned) mid)) { ncol = mid; lo = mid + 1; XFreeColors(xw->display, cmap, pgw->color.pixel, mid, (unsigned long)0); } else { hi = mid - 1; }; }; } while(ncol >= pgw->mincol && !XAllocColorCells(xw->display, cmap, False, planes, nplanes, pgw->color.pixel, (unsigned) ncol)); }; break; /* * For static color maps, color-cell pixel indexes will be assigned later * with XAllocColor() in xw_set_rgb(). For now simply assign 0 to all * pixels. */ case StaticColor: case TrueColor: case StaticGray: for(ncol=0; ncolcolor.pixel[ncol] = 0; ncol = maxcol; break; default: ncol = 0; break; }; }; return (ncol >= pgw->mincol) ? ncol : 0; } /*....................................................................... * Delete the color-cells of a colormap if pertinent and the colormap itself. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * vi XVisualInfo * The info descriptor of the visual containing the colormap. * cmap Colormap The colormap ID to be deleted. * ncol int The number of color cells allocated. * If <= 0 cell de-allocation will not be performed. * Output: * return int 0. */ #ifdef __STDC__ static int xw_del_Colormap(XWServer *xw, PGwin *pgw, XVisualInfo *vi, Colormap cmap, int ncol) #else static int xw_del_Colormap(xw, pgw, vi, cmap, ncol) XWServer *xw; PGwin *pgw; XVisualInfo *vi; Colormap cmap; int ncol; #endif { /* * Is there a colormap to be deleted? */ if(cmap != None) { /* * Delete colorcells if necessary. */ switch(vi->class) { case PseudoColor: case GrayScale: case DirectColor: if(ncol > 0) XFreeColors(xw->display, cmap, pgw->color.pixel, ncol,(unsigned long)0); break; }; /* * Delete the colormap if necessary. */ if(cmap != DefaultColormap(xw->display, pgw->screen)) XFreeColormap(xw->display, cmap); }; return 0; } /*....................................................................... * Prepare an existing PGPLOT window for active duty with a new PGPLOT * client. This involves installing the window on the active window list, * associating it with the new client, and arranging to detect pertinent * events on the client and PGPLOT window. * * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window descriptor. * client Window The client being assigned to this window. * protocol int The client/server communication protocol to use. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_prep_window(XWServer *xw, PGwin *pgw, Window client, int protocol) #else static int xw_prep_window(xw, pgw, client, protocol) XWServer *xw; PGwin *pgw; Window client; int protocol; #endif { /* * Associate the window with the new client. */ pgw->client = client; pgw->protocol = protocol; pgw->mapped = 0; /* * Select the events that we want to detect on the client's communication * window. Bracket the call with xw_sync_error() calls to determine * whether it generates any errors. An error here would mean that * the client communication window ID was invalid. Note that the * second xw_sync_error() call also has the effect of flushing the * event mask to the display so that hereafter if the window id becomes * invalid we will be informed of it through a DestroyNotify event. */ xw_sync_error(xw); XSelectInput(xw->display, pgw->client, (long) (StructureNotifyMask|PropertyChangeMask)); if(xw_sync_error(xw)) { fprintf(stderr, "%s: Failed to select events on client communication window (0x%lx).\n", PGXWIN_SERVER, (unsigned long) pgw->client); return 1; }; /* * Install the window in the active list. */ add_PGwin(&xw->active_list, 1, pgw); return 0; } /*....................................................................... * Send data to a client by placing data in the client's xw->client_data * property. * * Input: * xw XWServer * The PGPLOT /xw server descriptor. * pgw PGwin * The PGPLOT window to send to. * data unsigned char * The data to be sent, cast to (char *). * form int The format for the property. Recognised values and * the data types used to send them in data[] are: * XW_CHAR_PROP - (char) * XW_SHORT_PROP - (short) * XW_LONG_PROP - (long) * n unsigned long The number of items to be sent, in multiples of * 'size'. * type Atom The output property type (eg. XA_INTEGER). * Output: * return unsigned long The number of items sent==n, or 0 on error. */ #ifdef __STDC__ static unsigned long xw_send_data(XWServer *xw, PGwin *pgw, unsigned char *data, int form, unsigned long n, Atom type) #else static unsigned long xw_send_data(xw, pgw, data, form, n, type) XWServer *xw; PGwin *pgw; unsigned char *data; int form; unsigned long n; Atom type; #endif { XEvent event; /* Used to check for property-notify events */ long max_item; /* Max number of items transfereable in one go */ long ndone; /* The number of items sent so far */ long nnew; /* The number of items sent in the latest iteration */ unsigned long size; /* Size of property data element */ int waserr=0; /* True after an error */ /* * The property data expected by XChangeProperty is arranged as an array of * (char) if form=8, (short) if form=16, and (long) if form=32, * irrespective of the sizes of these types. Get the size of one such * element in bytes. */ switch(form) { case XW_CHAR_PROP: size = sizeof(char); break; case XW_SHORT_PROP: size = sizeof(short); break; case XW_LONG_PROP: size = sizeof(long); break; default: fprintf(stderr, "%s: Unknown property format: %d\n", PGXWIN_SERVER, form); return 0; break; }; /* * Determine the current maximum number of items that can be transfered * in one go. (Note that the units of XMaxRequestSize are mutliples of * 4 bytes). */ max_item = (4*XMaxRequestSize(xw->display))/size; /* * Send the data in one or more chunks of up to max_item items. */ for(ndone=0; !waserr && ndone max_item) ? max_item : (n-ndone); /* * Place the latest set of nnew items in the client's data property. */ XChangeProperty(xw->display, pgw->client, xw->client_data, type, form, PropModeReplace, data+ndone, (int)nnew); XFlush(xw->display); /* * Wait for the property to be deleted before sending more data. */ do { XWindowEvent(xw->display, pgw->client, (long) (StructureNotifyMask|PropertyChangeMask), &event); /* * If the client window is destroyed, rather than blocking forever waiting * for a property notify event, put the event back to be handled by * xw_event_loop(), cleanup and return the error status. */ if(event.type == DestroyNotify) { XPutBackEvent(xw->display, &event); return 0; }; } while(!waserr && !(event.type == PropertyNotify && event.xproperty.window == pgw->client && event.xproperty.atom == xw->client_data && event.xproperty.state == PropertyDelete)); }; /* * Terminate the transaction by sending a zero-length property value. */ XChangeProperty(xw->display, pgw->client, xw->client_data, type, form, PropModeReplace, data, 0); XFlush(xw->display); return ndone; } /*....................................................................... * Create two cursors for use by clients. One cursor is for use when * cursor input is expected, and the other for when it is not expected. * Also create a cursor for use by the server, to show when a window * is unassigned to any client. * * xw XWServer * The PGPLOT /xw server descriptor. * usecolor int 0 - Create a black and white cursor. * 1 - Create a color cursor. * Input/Output: * curs XWCursor * The cursor container to be filled. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_new_cursors(XWServer *xw, int usecolor, XWCursor *curs) #else static int xw_new_cursors(xw, usecolor, curs) XWServer *xw; int usecolor; XWCursor *curs; #endif { XColor bg,fg; /* Background and foreground colors */ /* * Create the new cursors. */ curs->norm = XCreateFontCursor(xw->display, XC_spider); curs->live = XCreateFontCursor(xw->display, XC_crosshair); curs->idle = XCreateFontCursor(xw->display, XC_pirate); if(curs->norm==None || curs->live==None || curs->idle==None) { fprintf(stderr, "%s: Error creating cursor.\n", PGXWIN_SERVER); return 1; }; /* * Initialize the common parts of the color descriptors. */ bg.pixel = fg.pixel = 0; bg.flags = fg.flags = DoRed | DoGreen | DoBlue; bg.pad = fg.pad = 0; /* * A black background will be used for all cursors. */ bg.red = bg.green = bg.blue = 0; /* * Give the normal cursor a yellow foreground color. */ fg.red = fg.green = COLORMULT; fg.blue = usecolor ? 0 : COLORMULT; XRecolorCursor(xw->display, curs->norm, &fg, &bg); /* * Give the active cursor a red foreground color. */ fg.red = COLORMULT; fg.green = fg.blue = usecolor ? 0:COLORMULT; XRecolorCursor(xw->display, curs->live, &fg, &bg); /* * Give the idle cursor a white foreground color. */ fg.red = fg.green = fg.blue = COLORMULT; XRecolorCursor(xw->display, curs->idle, &fg, &bg); return 0; } /*....................................................................... * Delete cursors created by xw_new_cursors(). * * xw XWServer * The PGPLOT /xw server descriptor. * curs XWCursor * The cursor container to be emptied. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_del_cursors(XWServer *xw, XWCursor *curs) #else static int xw_del_cursors(xw, curs) XWServer *xw; XWCursor *curs; #endif { if(curs->norm != None) XFreeCursor(xw->display, curs->norm); curs->norm = None; if(curs->live != None) XFreeCursor(xw->display, curs->live); curs->live = None; if(curs->idle != None) XFreeCursor(xw->display, curs->idle); curs->idle = None; return 0; } /*....................................................................... * Initialize a new cursor container to be empty. This must be called * before xw_new_cursors or xw_del_cursors so that it is clear which * cursors have been created and need to be deleted. * * xw XWServer * The PGPLOT /xw server descriptor. * curs XWCursor * The cursor container to be initialized. * Output: * return int 0 - OK. */ #ifdef __STDC__ static int xw_ini_cursors(XWServer *xw, XWCursor *curs) #else static int xw_ini_cursors(xw, curs) XWServer *xw; XWCursor *curs; #endif { curs->norm = None; curs->live = None; curs->idle = None; return 0; } /*....................................................................... * Return a dynamically allocated visual info structure for a given * visual. This is simply a more convenient interface to XGetVisualInfo() * and XVisualIDFromVisual(). * * Input: * display Display * The display connection to which the visual * belongs. * screen int The screen to which the visual belongs. * visual Visual * The visual for which information is required. * Output: * return XVisualInfo * The required information descriptor, or NULL * on error. */ #ifdef __STDC__ static XVisualInfo *xw_visual_info(Display *display, int screen, Visual *visual) #else static XVisualInfo *xw_visual_info(display, screen, visual) Display *display; int screen; Visual *visual; #endif { XVisualInfo *vi=NULL; /* The return descriptor */ XVisualInfo template; /* The search template */ int nret = 0; /* The number of descriptors returned */ /* * Using the visual ID and the screen should unambiguously select the * information for the specified visual. */ template.visualid = XVisualIDFromVisual(visual); template.screen = screen; vi = XGetVisualInfo(display, (long)(VisualIDMask | VisualScreenMask), &template, &nret); if(vi == NULL || nret < 1) { fprintf(stderr, "%s: Error getting visual information for visual ID 0x%lx, screen %d.\n", PGXWIN_SERVER, (unsigned long)template.visualid, screen); vi = NULL; }; return vi; } /*....................................................................... * Get X-resource configurable PGPLOT window attributes for a new window. * * Input: * display */ #ifdef __STDC__ static int xw_get_config(XWServer *xw, PGwin *pgw) #else static int xw_get_config(xw, pgw) XWServer *xw; PGwin *pgw; #endif { char *def = NULL; /* X resource value */ XWQuarks *qrk = &xw->quarks; /* * Initialize with server resource defaults. */ pgw->acceptquit = 0; pgw->iconize = 0; pgw->mincol = NCOLORS; pgw->maxcol = XW_DEF_COLORScrosshair = 0; pgw->visual_class = -1; /* * Override current defaults. * * Record whether WM_DELETE_WINDOW actions are to be accepted on * active windows. */ if((def = xw_get_default(xw, pgw->id, &qrk->acceptquit))) pgw->acceptquit = xw_parse_bool(def, False) == True; /* * Record whether persistent windows should be iconized when inactive. */ if((def = xw_get_default(xw, pgw->id, &qrk->iconize))) pgw->iconize = xw_parse_bool(def, False) == True; /* * Override the default minimum number of colors per colormap. */ if((def = xw_get_default(xw, pgw->id, &qrk->mincolors))) { pgw->mincol = atoi(def); if(pgw->mincol < XW_MIN_COLORS) pgw->mincol = XW_MIN_COLORS; if(pgw->mincol > XW_MAX_COLORS) pgw->mincol = XW_MAX_COLORS; }; /* * Override the default max number of colors per window. */ if((def = xw_get_default(xw, pgw->id, &qrk->maxcolors))) { pgw->maxcol = atoi(def); if(pgw->maxcol < XW_MIN_COLORS) pgw->maxcol = XW_MIN_COLORS; if(pgw->maxcol > XW_MAX_COLORS) pgw->maxcol = XW_MAX_COLORS; }; /* * Ensure that maxcol >= mincol. */ if(pgw->mincol > pgw->maxcol) pgw->maxcol = pgw->mincol; /* * See if a crosshair cursor should be used. */ if((def = xw_get_default(xw, pgw->id, &qrk->crosshair))) pgw->crosshair = xw_parse_bool(def, False) == True; /* * See what the default visual type should be. */ if((def = xw_get_default(xw, pgw->id, &qrk->visual))) pgw->visual_class = xw_parse_visual(def); return 0; } /*....................................................................... * Lookup a resource value from the X resource database. * This function must not be called before xw_get_xrdb() or xw_get_quarks(). * * Input: * xw XWServer * The server descriptor. * window_id int The numeric ID of the window to look up a * resource for, or 0 for a server resource. * pair XWQPair * Name/class quark pair of the resource to be * looked up. * Output: * return char * The resource value, or NULL if no value is * available. This is a pointer to an internal * static buffer. */ #ifdef __STDC__ static char *xw_get_default(XWServer *xw, int window_id, XWQPair *pair) #else static char *xw_get_default(xw, window_id, pair) XWServer *xw; int window_id; XWQPair *pair; #endif { static char resource[80]; /* Buffer for returned value */ XrmName win_name; /* Window specification quark */ XrmName name_list[4]; /* List of resource name components */ XrmClass class_list[4]; /* List of resource class components */ XrmRepresentation rep_type; /* Returned representation of resource */ XrmValue value; /* Resource value */ int have_value = 0; /* True once a resource value has been acquired */ /* * All resources share the initial program component. */ name_list[0] = xw->quarks.prog.name; class_list[0] = xw->quarks.prog.class; /* * If a specific window has been specified determine the window component * name to use and convert it to a quark. */ if(window_id) { sprintf(resource, "win%d", window_id); win_name = XrmStringToName(resource); name_list[1] = win_name; name_list[2] = pair->name; name_list[3] = NULLQUARK; class_list[1] = xw->quarks.win_class; class_list[2] = pair->class; class_list[3] = NULLQUARK; have_value = XrmQGetResource(xw->xrdb, name_list, class_list, &rep_type, &value)==True && value.size + 1 <= sizeof(resource); /* * For compatibility with the first version of pgxwin_server, allow * pgxwin.resource_name to be an alias for pgxwin.Win.resource_name. */ if(!have_value) { name_list[1] = pair->name; name_list[2] = NULLQUARK; class_list[1] = pair->class; class_list[2] = NULLQUARK; have_value = XrmQGetResource(xw->xrdb, name_list, class_list, &rep_type, &value)==True && value.size + 1 <= sizeof(resource); }; /* * Get server resource. */ } else { name_list[1] = xw->quarks.server.name; name_list[2] = pair->name; name_list[3] = NULLQUARK; class_list[1] = xw->quarks.server.class; class_list[2] = pair->class; class_list[3] = NULLQUARK; have_value = XrmQGetResource(xw->xrdb, name_list, class_list, &rep_type, &value)==True && value.size + 1 <= sizeof(resource); }; /* * Return a '\0' terminated copy of the resource value, or NULL if not * available. */ if(have_value) { strncpy(resource, (char *)value.addr, (int)value.size); resource[(int)value.size] = '\0'; return resource; }; return NULL; } /*....................................................................... * Create the X resource database. * * Input: * display Display * The display connection over which to check for the * RESOURCE_MANAGER root window property. * cmd_db XrmDatabase The command line resource database. * Output: * return XrmDatabase The initialized database. */ #ifdef __STDC__ static XrmDatabase xw_get_xrdb(Display *display, XrmDatabase cmd_db) #else static XrmDatabase xw_get_xrdb(display, cmd_db) Display *display; XrmDatabase cmd_db; #endif { XrmDatabase user_db = NULL; /* User specified database */ XrmDatabase env_db = NULL; /* Environment-specific database */ /* * Initialize the database manager. */ XrmInitialize(); /* * Get the XA_RESOURCE_MANAGER property from the root window. */ if(XResourceManagerString(display)) { user_db = XrmGetStringDatabase(XResourceManagerString(display)); } else { /* * If there was nothing on the root window, attempt to read the users * .Xdefaults file. */ #ifdef VMS user_db = XrmGetFileDatabase("DECW$USER_DEFAULTS:DECW$XDEFAULTS.DAT"); #else char *dir = xw_home_dir(); char *sep = "/"; char *file = ".Xdefaults"; if(dir) { char *path = (char *) malloc(sizeof(char) * (strlen(dir)+strlen(sep)+strlen(file) + 1)); if(path) { sprintf(path, "%s%s%s", dir, sep, file); user_db = XrmGetFileDatabase(path); free(path); }; }; #endif }; /* * See if an environment-specific database exists. */ { char *env = getenv("XENVIRONMENT"); if(env) env_db = XrmGetFileDatabase(env); }; /* * Merge the databases. */ XrmMergeDatabases(env_db, &user_db); /* * Override selected resources from the command-line resource database. */ XrmMergeDatabases(cmd_db, &user_db); return user_db; } /*....................................................................... * Get the user's home directory. * * Output: * return char * A statically allocated string containing the user's * home directory name, or NULL if not available. */ #ifdef __STDC__ static char *xw_home_dir(void) #else static char *xw_home_dir() #endif { char *home = NULL; #ifdef VMS home = "SYS$LOGIN"; #else if((home=getenv("HOME")) == NULL) { struct passwd *pwd = getpwuid(getuid()); if(pwd) home = pwd->pw_dir; }; #endif return home; } /*....................................................................... * Record quarks for frequently used resource-database components, in * xw->quarks. This must be called before xw_get_config(). * * Input: * xw XWServer * The server who's quark database is to be initialized. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_quarks(XWServer *xw) #else static int xw_get_quarks(xw) XWServer *xw; #endif { XWQuarks *q = &xw->quarks; q->prog.name = XrmStringToName("pgxwin"); q->prog.class = XrmStringToClass("Pgxwin"); q->display.name = XrmStringToName("display"); q->display.class = XrmStringToClass("Display"); q->server.name = XrmStringToName("server"); q->server.class = XrmStringToClass("Server"); q->geom.name = XrmStringToName("geometry"); q->geom.class = XrmStringToClass("Geometry"); q->iconize.name = XrmStringToName("iconize"); q->iconize.class = XrmStringToClass("Iconize"); q->acceptquit.name = XrmStringToName("acceptQuit"); q->acceptquit.class= XrmStringToClass("AcceptQuit"); q->mincolors.name = XrmStringToName("minColors"); q->mincolors.class = XrmStringToClass("MinColors"); q->maxcolors.name = XrmStringToName("maxColors"); q->maxcolors.class = XrmStringToClass("MaxColors"); q->visual.name = XrmStringToName("visual"); q->visual.class = XrmStringToClass("Visual"); q->crosshair.name = XrmStringToName("crosshair"); q->crosshair.class = XrmStringToClass("Crosshair"); q->visible.name = XrmStringToName("visible"); q->visible.class = XrmStringToClass("Visible"); q->icongeom.name = XrmStringToName("iconGeometry"); q->icongeom.class = XrmStringToClass("IconGeometry"); q->win_class = XrmStringToClass("Win"); return 0; } /*....................................................................... * Specify window state hints to the window manager. * * Input: * xw XWServer * The server descriptor. * screen int The screen on which the window resides. * window Window The window to which the hints apply. * id int The PGwin window number, or 0 for the server window. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_setwmhints(XWServer *xw, int screen, Window window, int id) #else static int xw_setwmhints(xw, screen, window, id) XWServer *xw; int screen; Window window; int id; #endif { XWMHints *hints; char *icongeom; /* Icon geometry resource value */ /* * Allocate the hints structure as recommended. */ hints = XAllocWMHints(); /* * Start with no hints specified. */ if(hints) { hints->flags = 0; /* * Server-specific hints. */ if(id==0) { hints->flags |= StateHint; /* The server window should start iconified */ hints->initial_state = IconicState; /* * PGPLOT window specific hints. */ } else { hints->flags |= InputHint; /* Register interest in keyboard input */ hints->input = True; }; /* * See if a geometry has been specified for the window icon. */ icongeom = xw_get_default(xw, id, &xw->quarks.icongeom); if(icongeom) { int x,y; unsigned int width; unsigned int height; int mask = XParseGeometry(icongeom, &x, &y, &width, &height); hints->flags |= IconPositionHint; if(mask & XValue) x = (mask & XNegative) ? DisplayWidth(xw->display, screen) - x : x; else x = 0; if(mask & YValue) y = (mask & YNegative) ? DisplayHeight(xw->display, screen) - y : y; else y = 0; hints->icon_x = (mask & XValue) ? x:0; hints->icon_y = (mask & YValue) ? y:0; }; /* * Install the hints if any were provided. */ if(hints->flags) XSetWMHints(xw->display, window, hints); XFree((char *)hints); } else { fprintf(stderr, "%s: Insufficient memory for position and state hints.\n", PGXWIN_SERVER); return 1; }; return 0; } /*....................................................................... * Set the window name and icon names for a window. * * Input: * xw XWServer * The server descriptor. * window Window The window to name. * w_name char * The name for the window. * i_name char * The name for the icon. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_name_window(XWServer *xw, Window window, char *w_name, char *i_name) #else static int xw_name_window(xw, window, w_name, i_name) XWServer *xw; Window window; char *w_name; char *i_name; #endif { /* * Get text-property version of the window name and assign it to the window. */ { XTextProperty window_name; if(XStringListToTextProperty(&w_name, 1, &window_name) == 0) { fprintf(stderr, "%s: Error allocating window name.\n", PGXWIN_SERVER); return 1; }; XSetWMName(xw->display, window, &window_name); XFree((char *)window_name.value); }; /* * Get text-property versions of the icon name and assign it to the window. */ { XTextProperty icon_name; if(XStringListToTextProperty(&i_name, 1, &icon_name) == 0) { fprintf(stderr, "%s: Error allocating icon name.\n", PGXWIN_SERVER); return 1; }; XSetWMIconName(xw->display, window, &icon_name); XFree((char *)icon_name.value); }; return 0; } /*....................................................................... * Acquire an up to date count of the number of error events generated * from all previous Xlib calls since the last time that this function * was called. This involves calling XSync() to ensure that all pending * requests have been processed, and clears the xw_handle_error() error * counter before returning. * * Thus, to determine whether a given function call causes any errors, * bracket it with two calls to xw_sync_error(). * * Input: * xw XWServer * The PGPLOT server descriptor. * Output: * return int The number of error events. */ #ifdef __STDC__ static int xw_sync_error(XWServer *xw) #else static int xw_sync_error(xw) XWServer *xw; #endif { /* * Force queued X requests to the server and wait for them to be processed. */ XSync(xw->display, False); /* * Ask the error handler for the current count of error events and to * clear its error counter by sending it a NULL XErrorEvent pointer. */ return xw_handle_error(xw->display, (XErrorEvent *) 0); } rks.win_class; class_list[2] = pair->class; class_list[3] = NULLQUARK; have_value = XrmQGetResource(xw->xrdb, name_list, class_list, &rep_type, &value)==True && value.size + 1 <= sizeof(resource); /* * For compatibility with the first version of pgxwin_server, allow * pgxwin.resource_name to be an alias for pgxwin.Win.resource_name. */ if(!have_value) { napgplot/drivers/hgdriv.f010064400040640000322000000313450634467252100156610ustar00tjpcitmbr00000400000017C*HGDRIV -- PGPLOT HPGL-2 driver C+ SUBROUTINE HGDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for HPGL-2 device. C----------------------------------------------------------------------- C Version 0.0 - 1990 Oct 18 - C. J. Lonsdale. C Version 1.0 - 1995 Jul 10 - renamed HGDRIV (TJP). C Version 1.1 - 1997 Jun 2 - removed some non-standard Fortran (TJP). C----------------------------------------------------------------------- C C This driver should work with any HP-GL/2 device, but has been tested C only with a Laserjet III printer. It takes advantage of the "PE" mode C compressed data format. In the Laserjet III used for testing, there C were two problems with using the PE format, both of which required C inelegant workarounds in the code. First, the PE mode is designed C to be used with relative addressing, but when PGPLOT tries to draw long C dashed/dotted lines there seems to be a systematic rounding error C internal to the printer which grows as n instead of sqrt(n), so that C serious cumulative positional errors can result. Attempts to work C around this by periodically inserting an absolute positioning command C revealed a second problem, namely that the "=" absolute positioning C flag in PE mode does not work. It was thus necessary to periodically C exit from PE mode, do absolute positioning in normal mode, then return C to PE mode. The file size overhead of this workaround is miminal (maybe C 5%). The printer rounding errors were ignored in the polygon fill C opcode, because in general the vectors will be of pseudo-random length C and direction, so errors will grow only as sqrt(n). C C Supported device: Any HPGL-2 device (presently tested only on HP laserjet 3) C C Device type code: /HPGL2 C C Default device name: PGPLOT.HPPLOT. C C Default view surface dimensions: 8.0in (horizontal) by 10.0in C (vertical). C C Resolution: 1016 (x) x 1016 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. 7 other shades of grey are available for lines and C area fill patterns. C It is not possible to change color representation. C C Input capability: None. C C File format: Ascii C C Obtaining hardcopy: Extremely system dependent C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='HPGL2 (Hewlett-Packard graphics)') PARAMETER (DEFNAM='pgplot.hpplot') CHARACTER*1 FF, EC C LOGICAL START, PEON INTEGER GROPTX INTEGER UNIT, IER, IC, NPTS, PCT, NREL INTEGER I0, J0, I1, J1, L, L1, L2, LASTI, LASTJ, LOBUF REAL LW CHARACTER*80 INSTR, MSG, DUMMY, DUMMY1, DUMMY2 CHARACTER*132 OBUF SAVE UNIT, IC, LASTI, LASTJ, LOBUF, OBUF, PEON, NREL SAVE FF, EC C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) FF=CHAR(12) EC=CHAR(27) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 8128 RBUF(3) = 0 RBUF(4) = 10160 RBUF(5) = 0 RBUF(6) = 9 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 1016.0 RBUF(2) = 1016.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, Area fill, C Thick lines) C 40 CHR = 'HNNATNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 8128 RBUF(3) = 0 RBUF(4) = 10160 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN DUMMY = CHR(:LCHR) CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 DUMMY(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF CALL GRHG02(UNIT,EC//'E') PEON = .FALSE. NREL = 0 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE(UNIT) CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C C Enter HPGL, black pen, thick lines have rounded ends and joins 110 CONTINUE CALL GRHG02(UNIT,EC//'%0BINSP1LA1,4,2,4PA1,1') LASTI = 1 LASTJ = 1 RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) C simple pen-down move IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN CALL GRHGEC((I1-I0), (J1-J0), INSTR, L) C pen up to start of line, then pen down to end of line ELSE CALL GRHGEC((I0-LASTI), (J0-LASTJ), DUMMY1, L1) CALL GRHGEC((I1-I0), (J1-J0), DUMMY2, L2) INSTR = '<'//DUMMY1(1:L1)//DUMMY2(1:L2) L = 1 + L1 + L2 C Make sure we are doing this in PE mode END IF IF(.NOT. PEON) THEN INSTR = 'PE7'//INSTR L = L + 3 PEON = .TRUE. NREL = 0 ENDIF LASTI = I1 LASTJ = J1 C Insert absolute position once in a while to keep LJIII in line NREL = NREL + 1 IF(NREL .GE. 30) THEN CALL GRFAO(';PUPA#,#PE7',L1,DUMMY1,LASTI,LASTJ,0,0) INSTR = INSTR(1:L)//DUMMY1(1:L1) L = L + L1 NREL = 0 ENDIF GOTO 800 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) C pen up move to position, then pen down CALL GRHGEC((I1-LASTI), (J1-LASTJ), DUMMY1, L1) CALL GRHGEC(0, 0, DUMMY2, L2) INSTR = '<'//DUMMY1(1:L1)//DUMMY2(1:L2) L = 1 + L1 + L2 IF(.NOT. PEON) THEN INSTR = 'PE7'//INSTR L = L + 3 PEON = .TRUE. NREL = 0 ENDIF LASTI = I1 LASTJ = J1 C LJIII obedience code as in line draw opcode NREL = NREL + 1 IF(NREL .GE. 30) THEN CALL GRFAO(';PUPA#,#PE7',L1,DUMMY1,LASTI,LASTJ,0,0) INSTR = INSTR(1:L)//DUMMY1(1:L1) L = L + L1 NREL = 0 ENDIF GOTO 800 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE IF (LOBUF.NE.0) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF CALL GRHG02(UNIT, ';'//EC//'E') PEON = .FALSE. RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) C white ... disable transparency mode. IF (IC.EQ.0) THEN INSTR = ';TR0SP0FT10,0SV0' L = 16 C Some shade of grey, enable transparency C Had to disable greys ... bad effects on line drawing CJL 3/6/92 ELSE PCT = 100 C IF(IC.EQ.1) PCT = 100 C IF(IC.EQ.2) PCT = 1 C IF(IC.EQ.3) PCT = 5 C IF(IC.EQ.4) PCT = 15 C IF(IC.EQ.5) PCT = 25 C IF(IC.EQ.6) PCT = 40 C IF(IC.EQ.7) PCT = 70 C IF(IC.EQ.8) PCT = 85 CALL GRFAO(';TR1SP1FT10,#SV1,#',L,INSTR,PCT,PCT,0,0) END IF PEON = .FALSE. GOTO 800 C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (LOBUF.NE.0) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) START = .TRUE. RETURN ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) C enter PE mode at first vertex IF (START) THEN CALL GRFAO(';PUPA#,#PMPE7', L, INSTR, I0, J0, 0, 0) START = .FALSE. LASTI = I0 LASTJ = J0 C last point, exit PE mode, polygon mode, and issue polygon fill. Then C reset the position to be safe. ELSE IF (NPTS.EQ.0) THEN CALL GRHGEC((I0-LASTI),(J0-LASTJ),DUMMY1,L1) INSTR = DUMMY1(1:L1)//';PM2FPPUPA1,1' L = L1 + 13 LASTI = 1 LASTJ = 1 PEON = .FALSE. NREL = 0 C Just another point ELSE CALL GRHGEC((I0-LASTI),(J0-LASTJ),INSTR,L) LASTI = I0 LASTJ = J0 END IF GOTO 800 ENDIF C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE C Fudged this ... lines looked too thick, maybe its the res. enhancement. LW = RBUF(1) * 0.127 - 0.05 IF(LW .EQ. 0.0) LW = 0.025 WRITE(DUMMY,'(F5.3)') LW INSTR = ';PW'//DUMMY L = 8 PEON = .FALSE. GOTO 800 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- C Buffer output if possible. Same as PS driver. C 800 IF ( (LOBUF+L+1). GT. 132) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) OBUF(1:L) = INSTR(1:L) LOBUF = L ELSE OBUF(LOBUF+1:LOBUF+L) = INSTR(1:L) LOBUF = LOBUF+L END IF RETURN C----------------------------------------------------------------------- END C*GRHGEC -- PGPLOT HPGL2 driver, convert integers to coded ascii C+ SUBROUTINE GRHGEC(X,Y,OUTSTR,L) C C Support routine for HPGL2 driver: converts integer coordinates C X and Y to base 32 in the ascii format suitable for PE command. C Output is a string, number of characters encoded returned in L. C---------------------------------------------------------------- INTEGER X, Y, L CHARACTER*(*) OUTSTR C INTEGER XREM, YREM C C Set the sign bit C X = X * 2 IF(X .LT. 0) X = 1 - X Y = Y * 2 IF(Y .LT. 0) Y = 1 - Y C C Loop through base-32 digits, treat last one with extra bit in C ascii character. Goes from least to most significant. C L = 0 OUTSTR = ' ' 10 CONTINUE XREM = MOD(X,32) X = X / 32 L = L + 1 IF(X .EQ. 0) GO TO 20 OUTSTR(L:L) = CHAR(63+XREM) GO TO 10 20 OUTSTR(L:L) = CHAR(95+XREM) C C Do Y coordinate same way as X above C 30 CONTINUE YREM = MOD(Y,32) Y = Y / 32 L = L + 1 IF(Y .EQ. 0) GO TO 40 OUTSTR(L:L) = CHAR(63+YREM) GO TO 30 40 OUTSTR(L:L) = CHAR(95+YREM) C RETURN END C*GRHG02 -- PGPLOT HPGL driver, copy buffer to file C+ SUBROUTINE GRHG02 (UNIT, S) C C Support routine for PSdriver: write character string S on C specified Fortran unit. C----------------------------------------------------------------------- INTEGER UNIT CHARACTER*(*) S C WRITE (UNIT, '(A)') S C----------------------------------------------------------------------- END pgplot/drivers/pgxwin.c010064400040640000322000004603420721555037500157120ustar00tjpcitmbr00000400000017#include #include #include #ifndef convex #include #endif /* X-Window include files */ #include #include #include #include #include "pgxwin.h" #define PGX_IDENT "pgxwin" #define PGX_IMAGE_LEN 1280 /* Length of the line-of-pixels buffer */ #define PGX_COLORMULT 65535 /* Normalized color intensity multiplier */ #define PGX_NCOLORS 16 /* Number of pre-defined PGPLOT colors */ #define PGX_QUERY_MAX 512 /* Max colormap query size in pgx_readonly_colors() */ /* A container used to record the geometry of the Pixmap */ typedef struct { float xpix_per_inch; /* Number of pixels per inch along X */ float ypix_per_inch; /* Number of pixels per inch along Y */ unsigned int width; /* Width of window (pixels) */ unsigned int height; /* Height of window (pixels) */ int xmargin; /* X-axis 1/4" margin in pixels */ int ymargin; /* Y-axis 1/4" margin in pixels */ int xmin,xmax; /* Min/max X-axis pixels excluding 1/4" margins */ int ymin,ymax; /* Min/max X-axis pixels excluding 1/4" margins */ } XWgeom; /* * Declare a colormap update descriptor. * This keeps a record of the number of buffered colormap updates * that need to be sent to the display. This allows color-representations * from multiple consecutive calls to pgscr() and pgshls() to be cached. */ typedef struct { int nbuff; /* The number of buffered color representation updates */ int sbuff; /* The index of the first buffered color representation */ } XWcolor; /* * Declare a polygon descriptor. */ typedef struct { XPoint *points; /* Temporary array of polygon vertexes */ int npoint; /* Number of points in polygon */ int ndone; /* The number of points received so far */ } XWpoly; /* * Declare a container used to record the extent of the rectangular * pixmap area that has been modified since the last pgx_flush(). */ typedef struct { int modified; /* True if 'pixmap' has been modified since last update */ int xmin,xmax; /* X-axis extent of modified region (pixels) */ int ymin,ymax; /* Y-axis extent of modified region (pixels) */ } XWupdate; /* * Declare a cursor state container. */ typedef struct { int drawn; /* True when the cursor is drawn */ GC gc; /* The graphical context of the cursor-band lines */ int warp; /* True to warp the cursor on first window entry */ int type; /* The cursor banding type PGX_..._CURSOR */ XPoint vbeg, vend; /* Start and end vertices of band cursors */ } XWcursor; /* * Declare a world-coordinate coordinate conversion object. */ typedef struct { float xoff, xdiv; /* world_x = (device_x - xoff) / xdiv */ float yoff, ydiv; /* world_y = (device_y - yoff) / ydiv */ } XWworld; /* * Declare a container to encapsulate the buffers needed to * draw a line of pixels. */ typedef struct { XImage *xi; /* Line of pixels Xlib image object */ } XWimage; /* * Declare a function type, instances of which are to be called to flush * buffered opcodes, and return 0 if OK, or 1 on error. */ typedef int (*Flush_Opcode_fn) ARGS((PgxWin *)); /* * The following container is used to retain state information for /xw * connections. */ struct PgxState { XWgeom geom; /* Pixmap geometry */ XWcolor color; /* Colormap state descriptor */ XWpoly poly; /* Polygon-fill accumulation descriptor */ XWupdate update; /* Descriptor of un-drawn area of pixmap */ XWcursor cursor; /* Cursor state context descriptor */ XWworld world; /* World-coordinate conversion descriptor */ XWimage image; /* Line of pixels container */ XGCValues gcv; /* Publicly visible contents of 'gc' */ GC gc; /* Graphical context descriptor */ int last_opcode; /* Index of last opcode */ Flush_Opcode_fn flush_opcode_fn; /* Function to flush a buffered opcode */ }; static int pgx_error_handler ARGS((Display *display, XErrorEvent *event)); static PgxColor *pgx_find_visual ARGS((PgxWin *pgx, int class, int min_col, \ int max_col, int readonly)); static int pgx_get_colorcells ARGS((PgxWin *pgx, PgxColor *color, \ int min_col, int max_col)); static int pgx_get_mutable_colorcells ARGS((PgxWin *pgx, PgxColor *color, \ int min_col, int max_col)); static XVisualInfo *pgx_visual_info ARGS((Display *display, int screen, \ VisualID vid)); static int pgx_parse_visual ARGS((char *str)); static void pgx_xy_to_XPoint ARGS((PgxWin *pgx, float *xy, XPoint *xp)); static void pgx_XPoint_to_xy ARGS((PgxWin *pgx, XPoint *xp, float *xy)); static void pgx_mark_modified ARGS((PgxWin *pgx, int x, int y, int diameter)); static int pgx_init_colors ARGS((PgxWin *pgx)); static int pgx_update_colors ARGS((PgxWin *pgx)); static int pgx_flush_colors ARGS((PgxWin *pgx, int ci_start, int ncol)); static int pgx_restore_line ARGS((PgxWin *pgx, int xa, int ya, int xb, int yb)); static int pgx_handle_cursor ARGS((PgxWin *pgx, float *rbuf, char *key)); static void pgx_limit_pcoords ARGS((PgxWin *pgx, XPoint *coord)); static void pgx_limit_wcoords ARGS((PgxWin *pgx, XPoint *coord)); static void pgx_window_to_pixmap ARGS((PgxWin *pgx, XPoint *w_coord, \ XPoint *p_coord)); static void pgx_pixmap_to_window ARGS((PgxWin *pgx, XPoint *p_coord, \ XPoint *w_coord)); static int pgx_copy_area ARGS((PgxWin *pgx, int px, int py, unsigned w, \ unsigned h, int wx, int wy)); static int pgx_clear_area ARGS((PgxWin *pgx, int x, int y, unsigned w, unsigned h)); PgxColor *new_PgxColor ARGS((PgxWin *pgx, int max_col, int readonly, \ VisualID vid)); static PgxColor *del_PgxColor ARGS((PgxWin *pgx, PgxColor *color)); static int pgx_default_class ARGS((PgxWin *pgx)); static int pgx_nint ARGS((float f)); static int pgx_readonly_colors ARGS((PgxWin *pgx, int ncol, XColor *colors, \ unsigned long *pixels)); static int pgx_cmp_xcolor ARGS((const void *va, const void *vb)); static int pgx_nearest_color ARGS((XColor *colors, int ncol, XColor *c)); /* * pgx_ready() accepts a state bitmask that contains a union of the * following enumerated resource requirement bits. */ #define PGX_NEED_COLOR 1 /* Colormap allocated */ #define PGX_NEED_WINDOW 2 /* Window created */ #define PGX_NEED_PIXMAP 4 /* A valid pixmap exists */ #define PGX_NEED_PGOPEN 8 /* Open to PGPLOT */ static int pgx_ready ARGS((PgxWin *pgx, int state)); /*....................................................................... * This function should be called to instantiate PgxWin::state when * an existing device is opened with pgbeg() or pgopen(). Note that all * but the pixmap and state members of the passed PgxWin structure must have * been instantiated. The pixmap member may either be instantiated or * be initialized with the null-atom constant: None. The state member * must be NULL. * * Input: * pgx PgxWin * The PGPLOT window context to connect to. * Output: * return PgxState * The PGPLOT drawing-state descriptor, or NULL * on error. */ #ifdef __STDC__ PgxState *pgx_open(PgxWin *pgx) #else PgxState *pgx_open(pgx) PgxWin *pgx; #endif { PgxState *state; /* The new state descriptor */ /* * Check the validity of the PgxWin structure. */ if(!pgx || !pgx->display || pgx->window==None || !pgx->expose_gc || pgx->bad_device || !pgx->name || !pgx->color) { fprintf(stderr, "pgx_open: Bad PgxWin descriptor.\n"); return NULL; }; if(pgx->state) { fprintf(stderr, "pgx_open: The specified device is already open.\n"); return NULL; }; /* * Allocate the state container. */ state = (PgxState *) malloc(sizeof(PgxState)); if(!state) { fprintf(stderr, "pgx_open: Insufficient memory.\n"); return NULL; }; /* * Before attempting any operation that might fail, initialize * the container at least up to the point at which it is * safe to pass it to pgx_close(). */ pgx->state = state; state->geom.xpix_per_inch = 0.0; state->geom.ypix_per_inch = 0.0; state->geom.width = 0; state->geom.height = 0; state->geom.xmargin = 0; state->geom.ymargin = 0; state->geom.xmin = 0; state->geom.xmax = 0; state->geom.ymin = 0; state->geom.ymax = 0; state->color.nbuff = 0; state->color.sbuff = 0; state->poly.points = NULL; state->poly.npoint = 0; state->poly.ndone = 0; state->update.modified = 0; state->update.xmin = 0; state->update.xmax = 0; state->update.ymin = 0; state->update.ymax = 0; state->cursor.drawn = 0; state->cursor.gc = NULL; state->cursor.type = PGX_NORM_CURSOR; state->world.xoff = 0.0; state->world.yoff = 0.0; state->world.xdiv = 1.0; state->world.ydiv = 1.0; state->image.xi = NULL; state->gc = NULL; state->last_opcode = 0; state->flush_opcode_fn = 0; /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ state->gcv.line_width = 1; state->gcv.cap_style = CapRound; state->gcv.join_style = JoinRound; state->gcv.fill_rule = EvenOddRule; state->gcv.graphics_exposures = False; state->gcv.foreground = WhitePixel(pgx->display, pgx->screen); /* * Bracket the actual creation with pgx_start/end_error() calls, to * determine whether any allocation errors occur. */ pgx_start_error_watch(pgx); state->gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCLineWidth | GCCapStyle | GCJoinStyle | GCFillRule | GCGraphicsExposures | GCForeground), &state->gcv); if(pgx_end_error_watch(pgx) || !state->gc) { fprintf(stderr, "%s: Failed to allocate graphical context.\n", PGX_IDENT); return pgx_close(pgx); }; /* * Create the X image that we use to compose lines of pixels with given * colors. */ pgx_start_error_watch(pgx); state->image.xi = XCreateImage(pgx->display, pgx->color->vi->visual, (unsigned)pgx->color->vi->depth, ZPixmap, 0, NULL, (unsigned)PGX_IMAGE_LEN, 1, 32, 0); if(pgx_end_error_watch(pgx) || !state->image.xi) { fprintf(stderr, "%s: Failed to allocate XImage descriptor.\n", PGX_IDENT); return pgx_close(pgx); }; /* * Allocate the image buffer. */ state->image.xi->data = malloc((size_t) state->image.xi->bytes_per_line); if(!state->image.xi->data) { fprintf(stderr, "%s: Failed to allocate image buffer.\n", PGX_IDENT); return pgx_close(pgx); }; /* * Create the cursor graphical context. */ pgx_start_error_watch(pgx); { XGCValues gcv; gcv.line_width = 0; gcv.graphics_exposures = False; gcv.foreground = WhitePixel(pgx->display, pgx->screen); state->cursor.gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCLineWidth | GCGraphicsExposures | GCForeground), &gcv); }; if(pgx_end_error_watch(pgx) || !state->cursor.gc) { fprintf(stderr, "%s: Failed to allocate graphical context.\n", PGX_IDENT); return pgx_close(pgx); }; /* * Initialize attributes. */ pgx_init_colors(pgx); pgx_set_ci(pgx, 1); pgx_set_lw(pgx, 1); pgx_set_cursor(pgx, 0, PGX_NORM_CURSOR, 0, NULL, NULL); return state; } /*....................................................................... * This function should be called to delete a pgx->state PGPLOT * drawing-state descriptor when pgend() is called. pgx->state will * also be assigned NULL. * * Input: * pgx PgxWin * The PGPLOT window context to disconnect. * Output: * return PgxState * The deleted PGPLOT drawing-state descriptor. * Always NULL. */ #ifdef __STDC__ PgxState *pgx_close(PgxWin *pgx) #else PgxState *pgx_close(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; /* * Delete the graphical context descriptor. */ if(state->gc) XFreeGC(pgx->display, state->gc); state->gc = NULL; /* * Delete the image descriptor. */ if(state->image.xi) XDestroyImage(state->image.xi); state->image.xi = NULL; /* * Check for un-freed polygon points. */ if(state->poly.points) free((char *)state->poly.points); state->poly.points = NULL; /* * Delete the cursor graphical context descriptor. */ if(state->cursor.gc) XFreeGC(pgx->display, state->cursor.gc); state->cursor.gc = NULL; /* * Delete the container. */ free(state); pgx->state = NULL; }; return NULL; } /*....................................................................... * This function must be called before each opcode is handled by the * device-specific driver dispatch function. * * Input: * pgx PgxWin * The PGPLOT window context. * opcode int The new opcode. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_pre_opcode(PgxWin *pgx, int opcode) #else int pgx_pre_opcode(pgx, opcode) PgxWin *pgx; int opcode; #endif { /* * If there is a buffered opcode and the latest opcode is not the same * as the last opcode, call the given flush function for the * buffered opcode. */ if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; if(state->last_opcode != opcode) { if(state->flush_opcode_fn != (Flush_Opcode_fn) 0) { (*state->flush_opcode_fn)(pgx); state->flush_opcode_fn = (Flush_Opcode_fn) 0; }; /* * Record the current opcode for next time. */ state->last_opcode = opcode; }; }; return 0; } /*....................................................................... * This function returns non-zero if the specified descriptor is not * NULL, not marked as bad via pgx->bad_device, and has all of the * specified resources. * * Input: * pgx PgxWin * The device descriptor to be checked. * state int A bitmask of resources that are required. * PGX_NEED_COLOR - Colormap allocated. * PGX_NEED_WINDOW - Window created. * PGX_NEED_PIXMAP - A valid pixmap exists. * PGX_NEED_PGOPEN - Open to PGPLOT. Note that * this implies that a colormap and window * exist but not that a pixmap exists. * Output: * return int 1 - Descriptor OK. * 0 - Error - don't use pgx. */ #ifdef __STDC__ static int pgx_ready(PgxWin *pgx, int state) #else static int pgx_ready(pgx, state) PgxWin *pgx; int state; #endif { if(!pgx || pgx->bad_device) return 0; if(state & PGX_NEED_COLOR && !pgx->color) return 0; if(state & PGX_NEED_WINDOW && pgx->window == None) return 0; if(state & PGX_NEED_PIXMAP && pgx->pixmap == None) return 0; if(state & PGX_NEED_PGOPEN && !pgx->state) return 0; return 1; } /*....................................................................... * Call this function when an Expose event is received. It will then * re-draw the exposed region from the pgx->pixmap, taking acount of any * scroll offsets in pgx->scroll. The device need not be open to PGPLOT. * * Input: * pgx PgxWin * The PGPLOT window context. * event XEvent * The expose event. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_expose(PgxWin *pgx, XEvent *event) #else int pgx_expose(pgx, event) PgxWin *pgx; XEvent *event; #endif { /* * Device error? */ if(pgx_ready(pgx, PGX_NEED_PIXMAP | PGX_NEED_WINDOW) && event->type==Expose) { pgx_copy_area(pgx, (int)(event->xexpose.x + pgx->scroll.x), (int)(event->xexpose.y + pgx->scroll.y), (unsigned) event->xexpose.width, (unsigned) event->xexpose.height, event->xexpose.x, event->xexpose.y); /* * Re-draw the possibly damaged cursor augmentation. */ pgx_refresh_cursor(pgx); /* * Ensure that the window responds immediately to the update. */ XFlush(pgx->display); if(pgx->bad_device) return 1; }; return 0; } /*....................................................................... * Scroll the pixmap within the window area. * * Input: * pgx PgxWin * The PGPLOT window context. * x,y unsigned The position of the top left corner of the window * within the pixmap. This allows for clients that * want to scroll the pixmap within the window area. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_scroll(PgxWin *pgx, unsigned x, unsigned y) #else int pgx_scroll(pgx, x, y) PgxWin *pgx; unsigned x; unsigned y; #endif { if(pgx_ready(pgx, 0)) { XEvent event; /* * Record the new scroll and pan values. */ pgx->scroll.x = x; pgx->scroll.y = y; /* * Redraw the scrolled contents of the window. */ if(pgx_ready(pgx, PGX_NEED_WINDOW | PGX_NEED_PIXMAP)) { XPoint brc; /* Bottom right corner of pixmap */ /* * We need to know the size of the window and the size of the pixmap. */ XWindowAttributes attr; XGetWindowAttributes(pgx->display, pgx->window, &attr); if(pgx->bad_device) return 1; /* * Record the bottom-right-corner pixmap coordinate in brc. */ { Window root; int x_root, y_root; unsigned width, height, border, depth; XGetGeometry(pgx->display, pgx->pixmap, &root, &x_root, &y_root, &width, &height, &border, &depth); brc.x = width - 1; brc.y = height - 1; }; /* * Determine the scrolled window coordinate at which the bottom right * corner of the pixmap lies. */ pgx_pixmap_to_window(pgx, &brc, &brc); /* * Clear the parts of the window that will not be covered by the pixmap. * Given that scroll.x and scroll.y are unsigned this can only be * areas to the left and bottom of the drawn area. */ if(brc.x < attr.width) { pgx_clear_area(pgx, (brc.x + 1), 0, (unsigned) (attr.width - brc.x - 1), (unsigned) (attr.height)); }; if(brc.y < attr.height) { pgx_clear_area(pgx, 0, (brc.y + 1), (unsigned)(attr.width), (unsigned)(attr.height - brc.y - 1)); }; /* * Set up a fake expose event to have the new pixmap area drawn. */ event.type = Expose; event.xexpose.x = 0; event.xexpose.y = 0; event.xexpose.width = brc.x + 1; event.xexpose.height = brc.y + 1; return pgx_expose(pgx, &event); }; }; return 1; } /*....................................................................... * Update the recorded extent of the drawable area of the window. * This must be called whenever the window is resized. * * Input: * pgx PgxWin * The PGPLOT window context. * doclip int 0 - Disable clipping entirely. * 1 - Clip all graphics outside the specified region. * width unsigned The width of the window. * height unsigned The height of the window. * border unsigned The width of the window border. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_update_clip(PgxWin *pgx, int doclip, unsigned width, unsigned height, unsigned border) #else int pgx_update_clip(pgx, doclip, width, height, border) PgxWin *pgx; int doclip; unsigned width; unsigned height; unsigned border; #endif { if(pgx_ready(pgx, 0)) { pgx->clip.doclip = doclip; pgx->clip.xmin = border; pgx->clip.ymin = border; pgx->clip.xmax = width - border - 1; pgx->clip.ymax = height - border - 1; return 0; }; return 1; } /*....................................................................... * Update the dimensions of the optional X and Y axis margins. The new * dimensions will be ignored until the start of the next page. * * Margins are blank areas left around the plottable viewsurface, purely * for esthetic reasons. * * Input: * pgx PgxWin * The PGPLOT window context. * xmargin int The number of pixels to leave either side of * the plot surface. * ymargin int The number of pixels to leave above and below * the plot suface. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_margin(PgxWin *pgx, int xmargin, int ymargin) #else int pgx_set_margin(pgx, xmargin, ymargin) PgxWin *pgx; int xmargin; int ymargin; #endif { if(pgx_ready(pgx, 0)) { pgx->xmargin = xmargin > 0 ? xmargin : 0; pgx->ymargin = ymargin > 0 ? ymargin : 0; return 0; }; return 1; } /*....................................................................... * Install a temporary error handler for use in detecting resource * allocation errors. The error handler will maintain a count of * errors, which will be returned by the matching function * pgx_end_error_watch(). These functions are intended to be used to * bracket resource allocation functions, in order to allow resource * allocation failures to be detected. * * Input: * pgx PgxWin * The PGPLOT window context descriptor. */ #ifdef __STDC__ void pgx_start_error_watch(PgxWin *pgx) #else void pgx_start_error_watch(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, 0)) { /* * Force all errors from previous events to be flushed. */ XSync(pgx->display, False); /* * Clear the error-handler internal error count. */ pgx_error_handler(pgx->display, (XErrorEvent *) 0); /* * Install the error handler. */ pgx->old_handler = XSetErrorHandler(pgx_error_handler); }; return; } /*....................................................................... * This function is paired with pgx_start_error_watch() and and after * ensuring that all errors have been trapped by calling XSync(), it * returns the error count recorded by the error handler that said function * installed. It then removes the error handler. * * Input: * pgx PgxWin * The PGPLOT window context descriptor. * Output: * return int The number of errors that were counted. */ #ifdef __STDC__ int pgx_end_error_watch(PgxWin *pgx) #else int pgx_end_error_watch(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, 0)) { /* * Ensure that all error-events have delivered. */ XSync(pgx->display, False); /* * De-install the error handler and re-instate the one that it displaced. */ XSetErrorHandler(pgx->old_handler); pgx->old_handler = 0; /* * Return the current error-count. */ return pgx_error_handler(pgx->display, (XErrorEvent *) 0); }; return 0; } /*....................................................................... * This function is called by X whenever a non-fatal error occurs * on a given display connection. For the moment it does nothing but * count such errors in an internal static error counter. This counter * can then be queried and reset by sending a NULL error event pointer. * * Input: * display Display * The display connection on which the error occured. * event XErrorEvent * The descriptor of the error event, or NULL to * request that the error counter be queried and reset. * Output: * return int The return value is not specified by Xlib, so * for Xlib calls we will simply return 0. For * none Xlib calls (distinguishable by sending * event==NULL), the value of the error counter * is returned. */ #ifdef __STDC__ static int pgx_error_handler(Display *display, XErrorEvent *event) #else static int pgx_error_handler(display, event) Display *display; XErrorEvent *event; #endif { static int error_count = 0; /* * To query and reset the error counter, this program calls pgx_error_handler() * with a NULL error event pointer. This distinguishes it from a call * from Xlib. */ if(!event) { int ret_count = error_count; error_count = 0; /* Reset the error counter */ return ret_count; /* Return the pre-reset value of the error counter */ #ifdef DEBUG } else { char errtxt[81]; /* Buffer to receive error message in */ /* * Get a message describing the error. */ XGetErrorText(display, (int)event->error_code, errtxt, (int)sizeof(errtxt)); fprintf(stderr, "%s: XErrorEvent: %s\n", ERROR_PREFIX, errtxt); /* * Report the operation that caused it. These opcode numbers are listed in * . */ fprintf(stderr, "%s: Major opcode: %d, Resource ID: 0x%lx%s.\n", ERROR_PREFIX, (int) event->request_code, (unsigned long) event->resourceid, (event->resourceid==DefaultRootWindow(display)?" (Root window)":"")); #endif }; /* * Keep a record of the number of errors that have occurred since the * error counter was last cleared. */ error_count++; return 0; } /*....................................................................... * Allocate a visual/colormap context and initialize it with defaults. * * Input: * pgx PgxWin * The PGPLOT window context. * max_col int The maximum number of colors to allow for. * readonly int True if readonly colors are sufficient. * vid VisualID The ID of the visual target visual. * Output: * return PgxColor * The new context descriptor, or NULL on error. */ #ifdef __STDC__ PgxColor *new_PgxColor(PgxWin *pgx, int max_col, int readonly, VisualID vid) #else PgxColor *new_PgxColor(pgx, max_col, readonly, vid) PgxWin *pgx; int max_col; int readonly; VisualID vid; #endif { PgxColor *color; /* The new context descriptor */ if(!pgx_ready(pgx, 0)) return NULL; /* * Allocate the context descriptor. */ color = (PgxColor *) malloc(sizeof(PgxColor)); if(!color) { fprintf(stderr, "%s: (new_PgxColor) Insufficient memory.\n", PGX_IDENT); return NULL; }; /* * Before attempting any operation that might fail, initialize the * color descriptor at least up to the point at which it can safely be * passed to del_PgxColor(). */ color->vi = NULL; color->cmap = None; color->private = 0; color->ncol = 2; color->monochrome = 1; color->pixel = NULL; color->npixel = 0; color->xcolor = NULL; color->initialized = 0; color->default_class = 0; color->readonly = readonly; color->nwork = 0; color->work = NULL; /* * Get the visual information object. */ color->vi = pgx_visual_info(pgx->display, pgx->screen, vid); if(!color->vi) return del_PgxColor(pgx, color); /* * See what type of color allocation will be needed. */ switch(color->vi->class) { case PseudoColor: case GrayScale: color->readonly = readonly; break; case DirectColor: color->readonly = 0; break; case StaticColor: case TrueColor: case StaticGray: color->readonly = 1; break; default: fprintf(stderr, "%s: Unknown colormap type.\n", PGX_IDENT); return del_PgxColor(pgx, color); break; }; /* * We can only handle between 2 and 256 colors. */ if(max_col < 2) max_col = 2; else if(max_col > 256) max_col = 256; /* * Determine the class of the default visual. */ color->default_class = pgx_default_class(pgx); /* * Allocate an array to store pixel indexes in. */ color->pixel = (unsigned long *) malloc(sizeof(unsigned long) * max_col); if(color->pixel==NULL) { fprintf(stderr, "%s: Insufficient memory for new PGPLOT window.\n", PGX_IDENT); return del_PgxColor(pgx, color); }; /* * Allocate an array to store color representations in. */ color->xcolor = (XColor *) malloc(sizeof(XColor) * max_col); if(!color->xcolor) { fprintf(stderr, "%s: Insufficient memory for new PGPLOT window.\n", PGX_IDENT); return del_PgxColor(pgx, color); }; /* * Allocate a work array for use by pgx_readonly_colors(). */ if(readonly) { color->nwork = color->vi->colormap_size; if(color->nwork > PGX_QUERY_MAX) color->nwork = PGX_QUERY_MAX; color->work = (XColor *) malloc(sizeof(XColor) * color->nwork); if(!color->work) { fprintf(stderr, "%s: Insufficient memory for shared-color allocation.\n", PGX_IDENT); return del_PgxColor(pgx, color); }; }; /* * Leave the rest of the initialization to specific functions. */ return color; } /*....................................................................... * Delete a color/visual context descriptor. * * Input: * pgx PgxWin * The PGPLOT window context. * color PgxColor * The descriptor to be deleted. * Output: * return PgxColor * The deleted descriptor (always NULL). */ #ifdef __STDC__ static PgxColor *del_PgxColor(PgxWin *pgx, PgxColor *color) #else static PgxColor *del_PgxColor(pgx, color) PgxWin *pgx; PgxColor *color; #endif { if(color) { if(color->vi) { if(color->cmap) { /* * Release allocated colorcells. */ if(pgx->display && color->pixel && color->npixel > 0) { XFreeColors(pgx->display, color->cmap, color->pixel, color->npixel, (unsigned long)0); }; }; /* * Delete the colormap only if we allocated it. */ if(pgx->display && color->private && color->cmap != DefaultColormap(pgx->display, pgx->screen)) XFreeColormap(pgx->display, color->cmap); /* * Delete the visual information descriptor. */ XFree((char *) color->vi); }; /* * Delete the pixel and color representation arrays. */ if(color->pixel) free(color->pixel); if(color->xcolor) free(color->xcolor); if(color->work) free(color->work); /* * Delete the container. */ free(color); }; return NULL; } /*....................................................................... * Return the colormap class of the default visual. * * Input: * pgx PgxWin * The PGPLOT window context descriptor. * Output: * return int The colormap class. */ #ifdef __STDC__ static int pgx_default_class(PgxWin *pgx) #else static int pgx_default_class(pgx) PgxWin *pgx; #endif { int class; XVisualInfo *vi = pgx_visual_info(pgx->display, pgx->screen, XVisualIDFromVisual(DefaultVisual(pgx->display, pgx->screen))); if(!vi) return PseudoColor; class = vi->class; XFree((char *) vi); return class; } /*....................................................................... * Search for an appropriate visual for a PGPLOT window and create a * colormap for it (unless the default visual is used). * * Input: * pgx PgxWin * The PGPLOT window context (We need the display * and screen members). * class_name char * The name of the desired visual class type. * min_col int The minimum acceptable number of colors before * switching to monochrome. * max_col int The maximum number of colors to allocate. * readonly int If true, try to allocate readonly colors. * false try to allocate read/write colors where * available. * Output: * return PgxColor * The color/visual context descriprot, or NULL * on error. */ #ifdef __STDC__ PgxColor *pgx_new_visual(PgxWin *pgx, char *class_name, int min_col, int max_col, int readonly) #else PgxColor *pgx_new_visual(pgx, class_name, min_col, max_col, readonly) PgxWin *pgx; char *class_name; int min_col; int max_col; int readonly; #endif { PgxColor *color = NULL; /* The new visual/colormap context descriptor */ int default_class; /* The class of the default visual */ int visual_class; /* The desired visual class */ if(!pgx_ready(pgx, 0)) return NULL; /* * Limit the number of colors to allowed values. */ if(min_col < 0) min_col = 0; else if(min_col > 256) min_col = 256; if(max_col < 0) max_col = 0; else if(max_col > 256) max_col = 256; /* * Determine the class of the default visual. */ default_class = pgx_default_class(pgx); /* * Decode the desired visual-class type. */ visual_class = pgx_parse_visual(class_name); /* * Use a specific visual class? */ if(visual_class >= 0) color = pgx_find_visual(pgx, visual_class, min_col, max_col, readonly); /* * Should we perform a search for a suitable visual class? */ if(visual_class == -1 || !color) { /* * Color display? */ switch(default_class) { case PseudoColor: case StaticColor: case DirectColor: case TrueColor: color = pgx_find_visual(pgx, PseudoColor, min_col, max_col, readonly); if(!color) color = pgx_find_visual(pgx, StaticColor, min_col, max_col, readonly); if(!color) color = pgx_find_visual(pgx, TrueColor, min_col, max_col, readonly); break; /* * Gray-scale display? */ case GrayScale: case StaticGray: color = pgx_find_visual(pgx, GrayScale, min_col, max_col, readonly); if(!color) color = pgx_find_visual(pgx, StaticGray, min_col, max_col, readonly); break; }; }; /* * If requested, or we failed to acquire the desired visual * use black and white colors from the default visual. */ return color ? color : pgx_bw_visual(pgx); } /*....................................................................... * Return a black and white visual/color context descriptor. * * Input: * pgx PgxWin * The PGPLOT window context (We need the display * and screen members). * Output: * return PgxColor * The context descriptor, or NULL on error. */ #ifdef __STDC__ PgxColor *pgx_bw_visual(PgxWin *pgx) #else PgxColor *pgx_bw_visual(pgx) PgxWin *pgx; #endif { PgxColor *color; /* The new descriptor */ if(!pgx_ready(pgx, 0)) return NULL; /* * Allocate the context descriptor. */ color = new_PgxColor(pgx, 2, 1, XVisualIDFromVisual(DefaultVisual(pgx->display, pgx->screen))); if(!color) return NULL; /* * Record the default-colormap ID. */ color->cmap = DefaultColormap(pgx->display, pgx->screen); /* * Record the two available colors. */ color->pixel[0] = BlackPixel(pgx->display, pgx->screen); color->pixel[1] = WhitePixel(pgx->display, pgx->screen); color->ncol = 2; /* * Record the fact that we are using monochrome. */ color->monochrome = 1; /* * Install the color context. */ pgx->color = color; /* * Initialize the colors. */ if(pgx_init_colors(pgx)) return pgx_del_visual(pgx); return color; } /*....................................................................... * Return a visual/color context descriptor for colors allocated from * the default colormap of the screen. * * Input: * pgx PgxWin * The PGPLOT window context (We need the display * and screen members). * min_col int The minimum acceptable number of colors before * switching to monochrome. * max_col int The maximum number of colors to allocate. * readonly int If true, try to allocate readonly colors. * false try to allocate read/write colors where * available. * Output: * return PgxColor * The context descriptor, or NULL on error. */ #ifdef __STDC__ PgxColor *pgx_default_visual(PgxWin *pgx, int min_col, int max_col,int readonly) #else PgxColor *pgx_default_visual(pgx, min_col, max_col, readonly) PgxWin *pgx; int min_col; int max_col; int readonly; #endif { PgxColor *color; /* The new descriptor */ if(!pgx_ready(pgx, 0)) return NULL; /* * Limit the number of colors to allowed values. */ if(min_col < 0) min_col = 0; else if(min_col > 256) min_col = 256; if(max_col < 0) max_col = 0; else if(max_col > 256) max_col = 256; /* * Allocate the context descriptor. */ color = new_PgxColor(pgx, max_col, readonly, XVisualIDFromVisual(DefaultVisual(pgx->display, pgx->screen))); if(!color) return NULL; /* * Record the default-colormap ID. */ color->cmap = DefaultColormap(pgx->display, pgx->screen); /* * Attempt to allocate colorcells from the default colormap. * If this fails return a visual that uses the black and white * pixels of the default visual. */ if(pgx_get_colorcells(pgx, color, min_col, max_col)) { color = del_PgxColor(pgx, color); return pgx_bw_visual(pgx); }; /* * Record the fact that we haven't reverted to monochrome. */ color->monochrome = 0; /* * Install the color context. */ pgx->color = color; /* * Initialize the colors. */ if(pgx_init_colors(pgx)) return pgx_del_visual(pgx); return color; } /*....................................................................... * Allocate colors from and return a visual/colormap context descriptor * for a specified existing visual and colormap. * * Input: * pgx PgxWin * The PGPLOT window context (We need the display * and screen members). * vid VisualID The ID of the visual to be used. (Note that * XGetVisualIDFromVisual() can be used to get the * visual ID of a visual from a (Visual *). * cmap Colormap The colormap to be used. This must be compatible * with the specified visual. * min_col int The minimum acceptable number of colors before * switching to monochrome. * max_col int The maximum number of colors to allocate. * readonly int If true, try to allocate readonly colors. If * false try to allocate read/write colors where * available. * Output: * return PgxColor * The context descriptor, or NULL on error. */ #ifdef __STDC__ PgxColor *pgx_adopt_visual(PgxWin *pgx, VisualID vid, Colormap cmap, int min_col, int max_col, int readonly) #else PgxColor *pgx_adopt_visual(pgx, vid, cmap, min_col, max_col, readonly) PgxWin *pgx; VisualID vid; Colormap cmap; int min_col; int max_col; int readonly; #endif { PgxColor *color; /* The new descriptor */ if(!pgx_ready(pgx, 0)) return NULL; /* * Limit the number of colors to allowed values. */ if(min_col < 0) min_col = 0; else if(min_col > 256) min_col = 256; if(max_col < 0) max_col = 0; else if(max_col > 256) max_col = 256; /* * Allocate the context descriptor. */ color = new_PgxColor(pgx, max_col, readonly, vid); if(!color) return NULL; /* * Record the colormap ID. */ color->cmap = cmap; /* * Attempt to allocate colors from the colormap. */ if(pgx_get_colorcells(pgx, color, min_col, max_col)) return del_PgxColor(pgx, color); /* * Install the color context. */ pgx->color = color; /* * Initialize the colors. */ if(pgx_init_colors(pgx)) return pgx_del_visual(pgx); return color; } /*....................................................................... * Allocate colors from and return a visual/colormap context descriptor * describing the visual and colormap of a specified other window. * * Input: * pgx PgxWin * The PGPLOT window context (We need the display * and screen members). * w Window The window to inherit the colormap and visual from. * min_col int The minimum acceptable number of colors before * switching to monochrome. * max_col int The maximum number of colors to allocate. * readonly int If true, try to allocate readonly colors. If * false try to allocate read/write colors where * available. * Output: * return PgxColor * The context descriptor, or NULL on error. */ #ifdef __STDC__ PgxColor *pgx_window_visual(PgxWin *pgx, Window w, int min_col, int max_col, int readonly) #else PgxColor *pgx_window_visual(pgx, w, min_col, max_col, readonly) PgxWin *pgx; Window w; int min_col; int max_col; int readonly; #endif { XWindowAttributes attr; /* The attributes of the specified window */ if(!pgx_ready(pgx, 0)) return NULL; /* * Acquire the attributes of the specified window. */ if(!XGetWindowAttributes(pgx->display, w, &attr)) { fprintf(stderr, "%s: (pgx_window_visual) Unable to get attributes of window: 0x%lx.\n", PGX_IDENT, (unsigned long) w); return NULL; }; /* * Install the visual and colormap recorded in the returned attributes. */ return pgx_adopt_visual(pgx, XVisualIDFromVisual(attr.visual), attr.colormap, min_col, max_col, readonly); } /*....................................................................... * Private function of pgx_new_visual(), used to find a visual of a given * class and at least min_col colors, allocate colors and return a * visual/colormap context descriptor for it. * * Input: * pgx PgxWin * The PGPLOT window context. * class int The type of colormap required, chosen from: * PseudoColor,StaticColor,GrayScale,StaticGray. * min_col int The minimum acceptable number of colors before * switching to monochrome. * max_col int The maximum number of colors to allocate. * readonly int If true, try to allocate readonly colors. If * false try to allocate read/write colors where * available. * Input/Output: * return PgxColor * The context of the new visual/colormap, or NULL * if sufficient colors could not be obtained. */ #ifdef __STDC__ static PgxColor *pgx_find_visual(PgxWin *pgx, int class, int min_col, int max_col, int readonly) #else static PgxColor *pgx_find_visual(pgx, class, min_col, max_col, readonly) PgxWin *pgx; int class; int min_col; int max_col; int readonly; #endif { PgxColor *color = NULL; /* The colormap/visual context to be returned */ XVisualInfo vi_template; /* Visual search template */ XVisualInfo *vi_list = NULL; /* List of matching visuals */ int nmatch; /* Number of matching visuals in vi_list[] */ VisualID vid; /* The id of a chosen private visual */ /* * If the default colormap has the right class, see if sufficient * colors can be allocated from it. */ if(class == pgx_default_class(pgx)) { color = pgx_default_visual(pgx, min_col, max_col, readonly); if(color->ncol >= max_col) return color; else color = del_PgxColor(pgx, color); }; /* * We need a private colormap. * Get a list of all visuals of the requested class. */ vi_template.class = class; vi_list = XGetVisualInfo(pgx->display, (long)VisualClassMask, &vi_template, &nmatch); if(!vi_list) return NULL; /* * Search the list for a visual that has a colormap size that * best matches max_col. Note that the colormap_size memeber of * the visual info structure effectively provides the number of * "independant" color table entries. Thus the following algorithm * works even for colormaps of TrueColor and DirectColor where the * colormap_size attribute refers to the size of a single primary color * table. */ { XVisualInfo *vi_below = NULL; XVisualInfo *vi_above = NULL; XVisualInfo *vi = NULL; for(vi=vi_list; vicolormap_size < max_col) { if(!vi_below || vi->colormap_size > vi_below->colormap_size) vi_below = vi; } else { if(!vi_above || vi->colormap_size < vi_above->colormap_size) vi_above = vi; }; }; /* * If available, use a visual that has at least max_col independant * colors. */ if(vi_above) vi = vi_above; else if(vi_below) vi = vi_below; else vi = NULL; /* * Get the ID of the visual if suitable. */ vid = (vi && vi->colormap_size > 2) ? vi->visualid : None; XFree((char *) vi_list); /* * Did we fail to get a usable visual? */ if(vid == None) return NULL; }; /* * Allocate a visual/colormap context descriptor. */ color = new_PgxColor(pgx, max_col, 0, vid); if(!color) return NULL; /* * Bracket the colormap acquisition with pgx_start/end_error() calls, to * determine whether any allocation errors occur. */ pgx_start_error_watch(pgx); color->cmap = XCreateColormap(pgx->display, DefaultRootWindow(pgx->display), color->vi->visual, AllocNone); if(pgx_end_error_watch(pgx) || color->cmap == None) { fprintf(stderr, "%s: XCreateColormap failed for visual: id=0x%lx class=%d depth=%u.\n", PGX_IDENT, (unsigned long)color->vi->visualid, color->vi->class, color->vi->depth); color->cmap = None; return del_PgxColor(pgx, color); }; /* * Allocate color-cells in the new colormap. */ if(pgx_get_colorcells(pgx, color, min_col, max_col)) return del_PgxColor(pgx, color); color->private = 1; color->monochrome = 0; /* * Install the color context. */ pgx->color = color; /* * Initialize the colors. */ if(pgx_init_colors(pgx)) return pgx_del_visual(pgx); return color; } /*....................................................................... * Private function of pgx_find_visual(), used to allocate color cells for a * given colormap and return a count of the number allocated. * * Input: * pgx PgxWin * The PGPLOT window context. * color PgxColor * The visual/colormap context descriptor. * The cmap and vi fields must be initialized before * calling this function. * min_col int The minimum acceptable number of colors. * max_col int The maximum number of colors to allocate. * Output: * color->pixel[] The colorcell indexes. * color->ncol The number of color pixels to use from color->pixel[]. * color->npixel The number of private color-cells allocated in pixel[]. * return int 0 - OK. * 1 - Unable to acquire at least min_col colors. */ #ifdef __STDC__ static int pgx_get_colorcells(PgxWin *pgx, PgxColor *color, int min_col, int max_col) #else static int pgx_get_colorcells(pgx, color, min_col, max_col, readonly) PgxWin *pgx; PgxColor *color; int min_col; int max_col; #endif { XVisualInfo *vi; /* Visual information (color->vi) */ Colormap cmap; /* Colormap ID (color->cmap) */ unsigned long maxcol; /* The max number of cells to attempt to allocate */ int i; /* * Get local pointers to relevant parts of the color context * descriptor. */ vi = color->vi; cmap = color->cmap; /* * Record the fact that no colors have been allocated. */ color->ncol = color->npixel = 0; /* * Determine the number of color cells in the colormap. */ switch(vi->class) { case PseudoColor: case GrayScale: case StaticColor: case StaticGray: maxcol = vi->colormap_size; break; case TrueColor: case DirectColor: /* * Determine the maximum number of significant colors available * by looking at the total number of bits set in the pixel bit-masks. */ maxcol = 1; { unsigned long rgb_mask = (vi->red_mask | vi->green_mask | vi->blue_mask); do { if(rgb_mask & (unsigned long)0x1) maxcol <<= (unsigned long)1; } while(maxcol < max_col && (rgb_mask >>= (unsigned long)1) != 0); }; break; default: maxcol = 0; break; }; /* * Limit the number of colorcells to the size of the color->pixel[] array. */ if(maxcol > max_col) maxcol = max_col; /* * Don't try to allocate anything if there are too few colors available. */ if(maxcol < min_col) { color->ncol = 0; /* * Defer shared color allocation to pgx_init_colors(). */ } else if(color->readonly) { for(i=0; ipixel[i] = 0; color->ncol = maxcol; color->npixel = 0; /* No pixels allocated yet */ /* * Allocate read/write colorcells. */ } else { if(pgx_get_mutable_colorcells(pgx, color, min_col, max_col)) return 1; }; /* * Too few colors? */ if(color->ncol < min_col) return 1; /* * We got more than two colors. */ color->monochrome = 0; return 0; } /*....................................................................... * This is a private function of pgx_get_colorcells() used to allocate * read/write colorcells. * * Input: * pgx PgxWin * The PGPLOT window context. * color PgxColor * The visual/colormap context descriptor. * The cmap and vi fields must be initialized before * calling this function. * min_col int The minimum acceptable number of colors. * max_col int The maximum number of colors to allocate. * Output: * color->pixel[] The colorcell indexes. * color->ncol The number of color pixels to use from color->pixel[]. * color->npixel The number of private color-cells allocated in pixel[]. * return int 0 - OK. * 1 - Unable to acquire at least min_col colors. */ #ifdef __STDC__ static int pgx_get_mutable_colorcells(PgxWin *pgx, PgxColor *color, int min_col, int max_col) #else static int pgx_get_mutable_colorcells(pgx, color, min_col, max_col) PgxWin *pgx; PgxColor *color; int min_col; int max_col; #endif { XVisualInfo *vi; /* Visual information (color->vi) */ Colormap cmap; /* Colormap ID (color->cmap) */ unsigned long maxcol; /* The max number of cells to attempt to allocate */ int ncol; /* The number of color-cells allocated */ unsigned long planes[1]; /* Dummy plane array needed by XAllocColorCells() */ unsigned int nplanes = 0; /* Dummy plane count needed by XAllocColorCells() */ /* * Get local pointers to relevant parts of the color context * descriptor. */ vi = color->vi; cmap = color->cmap; /* * Determine the max number of cells to try to allocate. */ maxcol = vi->colormap_size <= max_col ? vi->colormap_size : max_col; /* * See if we can get all of the colors requested. */ if(XAllocColorCells(pgx->display, cmap, False, planes, nplanes, color->pixel, (unsigned) maxcol)) { ncol = maxcol; /* * If there aren't at least min_col color cells available, then * give up on this colormap. */ } else if(!XAllocColorCells(pgx->display, cmap, False, planes, nplanes, color->pixel, (unsigned) min_col)) { ncol = 0; } else { /* * Since we were able to allocate min_col cells, we may be able to * allocate more. First discard the min_col cells, so that we can * try for a bigger number. */ XFreeColors(pgx->display, cmap, color->pixel, (int) min_col, (unsigned long)0); /* * Since there is no direct method to determine the number of allocatable * color cells available in a colormap, perform a binary search for the * max number that can be allocated. Note that it is possible that another * client may allocate colors from the same colormap while we search. This * invalidates the result of the search and is the reason for the outer * while loop. */ ncol = 0; do { int lo = min_col; int hi = maxcol; while(lo<=hi) { int mid = (lo+hi)/2; if(XAllocColorCells(pgx->display, cmap, False, planes, nplanes, color->pixel, (unsigned) mid)) { ncol = mid; lo = mid + 1; XFreeColors(pgx->display, cmap, color->pixel, mid, (unsigned long)0); } else { hi = mid - 1; }; }; } while(ncol >= min_col && !XAllocColorCells(pgx->display, cmap, False, planes, nplanes, color->pixel, (unsigned) ncol)); }; /* * Did we fail? */ if(ncol < min_col) return 1; /* * Record the number of pixels that will need to be free'd when * del_PgxColor() is eventually called. */ color->npixel = ncol; /* * Record the number of colors obtained. */ color->ncol = ncol; return 0; } /*....................................................................... * Return a dynamically allocated visual info structure for a given * visual. This is simply a more convenient interface to XGetVisualInfo() * and XVisualIDFromVisual(). * * Input: * display Display * The display connection to which the visual * belongs. * screen int The screen to which the visual belongs. * vid VisualID The ID of the visual for which information is * required. Note that the ID of a visual can * be obtained from XVisualIDFromVisual(). * Output: * return XVisualInfo * The required information descriptor, or NULL * on error. */ #ifdef __STDC__ static XVisualInfo *pgx_visual_info(Display *display, int screen, VisualID vid) #else static XVisualInfo *pgx_visual_info(display, screen, vid) Display *display; int screen; VisualID vid; #endif { XVisualInfo *vi=NULL; /* The return descriptor */ XVisualInfo template; /* The search template */ int nret = 0; /* The number of descriptors returned */ /* * Using the visual ID and the screen should unambiguously select the * information for the specified visual. */ template.visualid = vid; template.screen = screen; vi = XGetVisualInfo(display, (long)(VisualIDMask | VisualScreenMask), &template, &nret); if(vi == NULL || nret < 1) { fprintf(stderr, "%s: Error getting visual information for visual ID 0x%lx, screen %d.\n", PGX_IDENT, (unsigned long)template.visualid, screen); vi = NULL; }; return vi; } /*....................................................................... * Delete the contents of a pgx->color structure. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return PgxColor * The deleted color context (always NULL). */ #ifdef __STDC__ PgxColor *pgx_del_visual(PgxWin *pgx) #else PgxColor *pgx_del_visual(pgx) PgxWin *pgx; #endif { if(pgx) pgx->color = del_PgxColor(pgx, pgx->color); return NULL; } /*....................................................................... * Check a resource string value against visual class names. * * Input: * str char * The string value to be tested (NULL is ok). * Output: * return int The Visual class parsed, or -1 to select the default. */ #ifdef __STDC__ static int pgx_parse_visual(char *str) #else static int pgx_parse_visual(str) char *str; #endif { /* * Create a lookup table of recognised visual classes. */ static struct { char *name; /* Name of visual class */ int class; /* Enumerated identifier of visual class */ } classes[] = { {"monochrome", -2}, {"default", -1}, {"pseudocolor", PseudoColor}, {"directcolor", TrueColor}, /* We can't handle DirectColor */ {"staticcolor", StaticColor}, {"truecolor", TrueColor}, {"grayscale", GrayScale}, {"staticgray", StaticGray} }; int i; /* * Lookup the given class name. */ if(str) { for(i=0; ibad_device=1. * * Input: * pgx PgxWin * The descriptor of the device on which the error * occurred. * Output: * pgx->bad_device This flag is set to 1. * return int Allways 1 (intended as a boolean to say that the * device is unusable). This can be used as the return * value for functions that use 1 to denote an error * return. eg. * if(error_occurred) * return pgx_bad_device(pgx); */ #ifdef __STDC__ int pgx_bad_device(PgxWin *pgx) #else int pgx_bad_device(pgx) PgxWin *pgx; #endif { /* * Only report an error if this is the first time that this function * has been called on this device. */ if(pgx && !pgx->bad_device) { fprintf(stderr, "%s: Lost PGPLOT window.\n", PGX_IDENT); pgx->bad_device = 1; }; return 1; } /*....................................................................... * Draw a line segment in an open PGPLOT window. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_draw_line(PgxWin *pgx, float *rbuf) #else void pgx_draw_line(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; /* * Convert from PGPLOT coordinates to X coordinates. */ XPoint start; XPoint end; pgx_xy_to_XPoint(pgx, &rbuf[0], &start); pgx_xy_to_XPoint(pgx, &rbuf[2], &end); /* * Draw the line segment. */ XDrawLine(pgx->display, pgx->pixmap, state->gc, start.x, start.y, end.x, end.y); /* * Record the extent of the modified region of the pixmap. */ pgx_mark_modified(pgx, start.x, start.y, state->gcv.line_width); pgx_mark_modified(pgx, end.x, end.y, state->gcv.line_width); }; return; } /*....................................................................... * Draw a single dot in an open PGPLOT window. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_draw_dot(PgxWin *pgx, float *rbuf) #else void pgx_draw_dot(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; XPoint xp; /* * Workd out the radius of the dot. */ int radius = state->gcv.line_width/2; /* * Convert from PGPLOT coordinates to window coordinates. */ pgx_xy_to_XPoint(pgx, rbuf, &xp); /* * Draw a pixel-sized point, or a larger circular dot? */ if(radius < 1) { XDrawPoint(pgx->display, pgx->pixmap, state->gc, xp.x, xp.y); } else { unsigned int diameter = radius*2; int x = xp.x - radius; int y = xp.y - radius; XFillArc(pgx->display, pgx->pixmap, state->gc, x, y, diameter, diameter, 0, 23040); }; /* * Record the extent of the modified region of the pixmap. */ pgx_mark_modified(pgx, xp.x, xp.y, state->gcv.line_width); }; return; } /*....................................................................... * Convert from the coordinates sent by PGPLOT in rbuf[...] to an * X-windows point in the coordinate system of the pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * xy float [2] Array of two floats containing PGPLOT coordinates * arranged as x followed by y. * Output: * xp XPoint * The converted coordinates will be assigned to xp->x * and xp->y. */ #ifdef __STDC__ static void pgx_xy_to_XPoint(PgxWin *pgx, float *xy, XPoint *xp) #else static void pgx_xy_to_XPoint(pgx, xy, xp) PgxWin *pgx; float *xy; XPoint *xp; #endif { PgxState *state = pgx->state; float x = xy[0]; float y = xy[1]; /* * Limit the coordinates to lie within the pixmap. */ if(x < 0) x = 0; if(x >= state->geom.width) x = state->geom.width; if(y < 0) y = 0; if(y >= state->geom.height) y = state->geom.height; /* * Convert to pixmap coordinates. */ xp->x = state->geom.xmin + (int)(x + 0.5); xp->y = state->geom.ymax - (int)(y + 0.5); } /*....................................................................... * Convert from pixmap pixel coordinates to PGPLOT coordinates, in a * form that can be returned to PGPLOT via rbuf[...]. * * Input: * pgx PgxWin * The PGPLOT window context. * xp XPoint * The pixmap pixel-coordinates to be converted. * Output: * xy float [2] Output array of two floats in which to place the * PGPLOT coordinates, arranged as x followed by y. */ #ifdef __STDC__ static void pgx_XPoint_to_xy(PgxWin *pgx, XPoint *xp, float *xy) #else static void pgx_XPoint_to_xy(pgx, xp, xy) PgxWin *pgx; XPoint *xp; float *xy; #endif { PgxState *state = pgx->state; xy[0] = (float) (xp->x - state->geom.xmin); xy[1] = (float) (state->geom.ymax - xp->y); } /*....................................................................... * Update the vertices of the rectangular area that has been modified * since the last time the window was updated from the pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * x int The x-axis pixel index that the rectangular update area * must be extended to include. * y int The y-axis pixel index that the rectangular update area * must be extended to include. * diameter int The diameter of the locus in pixels. For line or * point drawing operations this is usually the line width. */ #ifdef __STDC__ static void pgx_mark_modified(PgxWin *pgx, int x, int y, int diameter) #else static void pgx_mark_modified(pgx, x, y, diameter) PgxWin *pgx; int x; int y; int diameter; #endif { PgxState *state = pgx->state; int radius = diameter/2; /* * Expand the current rectangle to include point (x,y). */ if(state->update.modified) { if(x - radius < state->update.xmin) state->update.xmin = x - radius; if(x + radius > state->update.xmax) state->update.xmax = x + radius; if(y - radius < state->update.ymin) state->update.ymin = y - radius; if(y + radius > state->update.ymax) state->update.ymax = y + radius; } else { state->update.xmin = x - radius; state->update.xmax = x + radius; state->update.ymin = y - radius; state->update.ymax = y + radius; state->update.modified = 1; }; return; } /*....................................................................... * Flush changes in the pixmap to the window. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_flush(PgxWin *pgx) #else int pgx_flush(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; /* * Flush buffered opcodes if necessary. */ if(state->flush_opcode_fn != (Flush_Opcode_fn) 0) { (*state->flush_opcode_fn)(pgx); state->flush_opcode_fn = (Flush_Opcode_fn) 0; if(pgx->bad_device) return 1; }; /* * Copy the modified rectangular area of the pixmap to the PGPLOT window. */ if(state->update.modified) { /* * Enforce bounds on the area to be updated. */ if(state->update.xmin < 0) state->update.xmin = 0; if(state->update.ymin < 0) state->update.ymin = 0; if(state->update.xmax > state->geom.width - 1) state->update.xmax = state->geom.width - 1; if(state->update.ymax > state->geom.height - 1) state->update.ymax = state->geom.height - 1; /* * Copy the area to be updated from the pixmap to the window. */ if(!pgx->bad_device) { pgx_copy_area(pgx, state->update.xmin, state->update.ymin, (unsigned) (state->update.xmax - state->update.xmin + 1), (unsigned) (state->update.ymax - state->update.ymin + 1), (int) (state->update.xmin - pgx->scroll.x), (int) (state->update.ymin - pgx->scroll.y)); if(pgx->bad_device) return 1; }; state->update.modified = 0; }; /* * Redraw the potentially damaged rubber-band cursor if it is active. */ pgx_refresh_cursor(pgx); /* * Make sure that the window is up to date. */ XFlush(pgx->display); if(pgx->bad_device) return 1; }; return 0; } /*....................................................................... * Set the foreground color. * * Input: * pgx PgxWin * The PGPLOT window context. * ci int The PGPLOT color index to instate as the foreground * color. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_ci(PgxWin *pgx, int ci) #else int pgx_set_ci(pgx, ci) PgxWin *pgx; int ci; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; /* * Assign white to out-of range color indexes. */ if(ci < 0 || ci >= pgx->color->ncol) ci = 1; /* * Determine the color pixel associated with the given color index. */ state->gcv.foreground = pgx->color->pixel[ci]; /* * Instate the new foreground color. */ XSetForeground(pgx->display, state->gc, state->gcv.foreground); if(pgx->bad_device) return 1; }; return 0; } /*....................................................................... * This function is called mulitple times to accumulate a list of * polygon vertices and finally draw them. This protocol is mandated * by the PGPLOT GREXEC driver dispatch function. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_poly_fill(PgxWin *pgx, float *rbuf) #else void pgx_poly_fill(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; /* * The first call specifies just the number of vertixes in the polygon. */ if(state->poly.npoint == 0) { state->poly.npoint = (int) (rbuf[0] + 0.5); state->poly.points = (XPoint *) malloc(sizeof(XPoint) * state->poly.npoint); if(state->poly.points == NULL) fprintf(stderr, "%s: Insufficient memory for polygon points.\n", PGX_IDENT); state->poly.ndone = 0; /* * The next state->poly.npoint calls specify the vertexes of the polygon. */ } else { /* * Ignore the points if the above malloc() failed. */ if(state->poly.points) { XPoint *xp = &state->poly.points[state->poly.ndone]; pgx_xy_to_XPoint(pgx, rbuf, xp); pgx_mark_modified(pgx, xp->x, xp->y, 1); }; /* * Maintain the count of the number of points, even if no memory for the * points is available. Thus we can just ignore all calls until * state->poly.ndone == state->poly.npoint. */ state->poly.ndone++; /* * On the last call display the filled polygon and release the memory used * to store its vertexes. */ if(state->poly.ndone >= state->poly.npoint) { if(state->poly.points) { XFillPolygon(pgx->display, pgx->pixmap, state->gc, state->poly.points, state->poly.npoint, Complex, CoordModeOrigin); free((char *)state->poly.points); state->poly.points = NULL; }; state->poly.npoint = 0; }; }; }; return; } /*....................................................................... * Draw a filled rectangle. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_rect_fill(PgxWin *pgx, float *rbuf) #else void pgx_rect_fill(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { /* * Convert from PGPLOT coordinates to X coordinates. */ XPoint blc; XPoint trc; pgx_xy_to_XPoint(pgx, &rbuf[0], &blc); pgx_xy_to_XPoint(pgx, &rbuf[2], &trc); /* * Fill the rectangle in the pixmap. */ XFillRectangle(pgx->display, pgx->pixmap, pgx->state->gc, blc.x, trc.y, (unsigned)(trc.x-blc.x+1), (unsigned)(blc.y-trc.y+1)); /* * Record the extent of the modified part of the pixmap. */ pgx_mark_modified(pgx, blc.x, blc.y, 1); pgx_mark_modified(pgx, trc.x, trc.y, 1); }; return; } /*....................................................................... * Set the line width for subsequent drawing. * * Input: * pgx PgxWin * The PGPLOT window context. * lw float The new line width in units of 0.005 inches. */ #ifdef __STDC__ void pgx_set_lw(PgxWin *pgx, float lw) #else void pgx_set_lw(pgx, lw) PgxWin *pgx; float lw; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; /* * The line width is provided in multiples of 0.005 inches. */ state->gcv.line_width = (lw * 0.005 * state->geom.xpix_per_inch) + 0.5; XChangeGC(pgx->display, state->gc, (unsigned long)GCLineWidth, &state->gcv); }; return; } /*....................................................................... * Render a line of pixels. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. * nbuf int * The number of floats passed in rbuf[] by GREXEC. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_pix_line(PgxWin *pgx, float *rbuf, int *nbuf) #else int pgx_pix_line(pgx, rbuf, nbuf) PgxWin *pgx; float *rbuf; int *nbuf; #endif { int i; if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP) && !pgx->color->monochrome) { PgxState *state = pgx->state; /* The PGPLOT drawing-state context */ int ndone; /* The number of pixels drawn so far */ /* * Extract the array of pixels and the recorded number thereof. */ float *cells = rbuf + 2; /* Array of pixels */ int ncell = *nbuf - 2; /* The number of pixels in cells[] */ /* * Get the container of the X image used to transport lines of pixels. */ XWimage *image = &pgx->state->image; /* * The first two elements of the rbuf[] array contain the * X and Y PGPLOT coordinates of the start of the line of pixels. * Convert this to X coordinates. */ XPoint start; pgx_xy_to_XPoint(pgx, rbuf, &start); /* * Draw up to PGX_IMAGE_LEN pixels at a time. This is the size of the * buffer: state->xi->data[]. */ for(ndone=0; !pgx->bad_device && ndonecolor->vi->depth == 8) { for(i=0; ixi->data[i] = pgx->color->pixel[(int) (cells[ndone+i] + 0.5)]; } else { for(i=0; ixi, i, 0, pgx->color->pixel[(int) (cells[ndone+i] + 0.5)]); }; }; /* * Display the image. */ XPutImage(pgx->display, pgx->pixmap, state->gc, image->xi, 0, 0, start.x+ndone, start.y, (unsigned) nimage, (unsigned) 1); }; /* * Extend the region to be updated on the next flush. */ pgx_mark_modified(pgx, start.x, start.y, 1); pgx_mark_modified(pgx, start.x + ncell - 1, start.y, 1); }; if(pgx->bad_device) return 1; return 0; } /*....................................................................... * Record the latest world-coordinate conversion parameters as provided * by the PGPLOT driver opcode 27. Note that opcode 27 only gets invoked * by PGPLOT if the second character of the attribute string returned by * opcode 4 is set to 'X'. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine for opcode 27. In order these * are: xoff, xdiv, yoff and ydiv; where: * world_x = (device_x - xoff) / xdiv * world_y = (device_y - yoff) / ydiv */ #ifdef __STDC__ void pgx_set_world(PgxWin *pgx, float *rbuf) #else void pgx_set_world(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { XWworld *world = &pgx->state->world; world->xoff = rbuf[0]; world->xdiv = rbuf[1]; world->yoff = rbuf[2]; world->ydiv = rbuf[3]; }; } /*....................................................................... * Assign a given RGB color representation to a given color index in * pgx->color->xcolor and if the device is open to PGPLOT, record the * extent of the modifications in pgx->state->update and * register pgx_update_colors() to pgx->state->flush_opcode_fn(). * * Input: * pgx PgxWin * The PGPLOT window context. * ci int The color index to assign the color to. Out of range * indexes are quietly ignored. * red float The fractional red brightness 0..1. * green float The fractional green brightness 0..1. * blue float The fractional blue brightness 0..1. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_rgb(PgxWin *pgx, int ci, float red, float green, float blue) #else int pgx_set_rgb(pgx, ci, red, green, blue) PgxWin *pgx; int ci; float red; float green; float blue; #endif { float gray; /* Gray-scale intensity */ XColor *xc; /* The descriptor of the new color */ /* * Do we have a valid device. */ if(pgx_ready(pgx, PGX_NEED_COLOR)) { PgxState *state = pgx->state; /* * Limit RGB values to be between 0 and 1. */ if(red < 0.0) red = 0.0; if(green < 0.0) green = 0.0; if(blue < 0.0) blue = 0.0; if(red > 1.0) red = 1.0; if(green > 1.0) green = 1.0; if(blue > 1.0) blue = 1.0; /* * Color index in range? */ if(!pgx->color->monochrome && ci >= 0 && ci < pgx->color->ncol) { /* * Get the color representation descriptor. */ xc = &pgx->color->xcolor[ci]; /* * Get the pixel to be assigned the new color representation. */ xc->pixel = pgx->color->pixel[ci]; xc->flags = DoRed | DoGreen | DoBlue; xc->pad = 0; /* * Determine the appropriate RGB values for the type of colormap. */ switch(pgx->color->vi->class) { case PseudoColor: case StaticColor: case DirectColor: case TrueColor: xc->red = (int) (red * PGX_COLORMULT + 0.5); xc->green = (int) (green * PGX_COLORMULT + 0.5); xc->blue = (int) (blue * PGX_COLORMULT + 0.5); break; case GrayScale: case StaticGray: /* * For gray-scale colormaps the red,green and blue intensities must all be * equal. Weight the colors so that what is brightest to the eye, is also * brighter in grayscale, and so that different colors of equal intensity * appear different in grayscale. Note that the 3 weights must add up to 1.0. * The black and white TV standard says to use 0.3*R+0.59*G+0.11*B. * Unfortunately blue pretty much dissapears in this scheme. The following * is a compromise between making all colors visible and making different * colors look different in grayscale. */ gray = 0.35*red + 0.40*green + 0.25*blue; xc->red = xc->green = xc->blue = (int) (gray * PGX_COLORMULT + 0.5); break; }; /* * Update the recorded range of color indexes whose color representations * have been changed since the last call to pgx_update_colors(). */ if(state) { if(state->color.nbuff<=0) { state->color.sbuff = ci; state->color.nbuff = 1; } else if(ci < state->color.sbuff) { state->color.nbuff += state->color.sbuff - ci; state->color.sbuff = ci; } else if(ci > state->color.sbuff + state->color.nbuff-1) { state->color.nbuff = ci - state->color.sbuff + 1; }; /* * Register pgx_update_colors() to be called to flush the colors to the * window. Don't do this if we are sharing readonly colors, because * these should not be reallocated until the start of the next page. */ if(!pgx->color->readonly) state->flush_opcode_fn = (Flush_Opcode_fn) pgx_update_colors; }; }; }; return 0; } /*....................................................................... * Initialize the color representations in the color table. * pgx_get_visual() must have been called prior to calling this function, * so that we have a visual and colormap to define the colors in. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * pgx->color->xcolor[0..ncol] The color pixel definitions. * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_init_colors(PgxWin *pgx) #else static int pgx_init_colors(pgx) PgxWin *pgx; #endif { /* * Define the standard PGPLOT line colors (RGB). */ static float ctable[PGX_NCOLORS][3] = { {0.0,0.0,0.0}, {1.0,1.0,1.0}, {1.0,0.0,0.0}, {0.0,1.0,0.0}, {0.0,0.0,1.0}, {0.0,1.0,1.0}, {1.0,0.0,1.0}, {1.0,1.0,0.0}, {1.0,0.5,0.0}, {0.5,1.0,0.0}, {0.0,1.0,0.5}, {0.0,0.5,1.0}, {0.5,0.0,1.0}, {1.0,0.0,0.5}, {0.333,0.333,0.333}, {0.667,0.667,0.667} }; int i; if(pgx_ready(pgx, PGX_NEED_COLOR)) { /* * Initialize the color-table with the standard PGPLOT line colors. */ if(!pgx->color->monochrome) { int ncol = (PGX_NCOLORS < pgx->color->ncol) ? PGX_NCOLORS:pgx->color->ncol; for(i=0; icolor->ncol; i++) { float grey= (float) (i-PGX_NCOLORS) / (float) (pgx->color->ncol-1-PGX_NCOLORS); if(pgx_set_rgb(pgx, i, grey, grey, grey)) return 1; }; }; /* * Flush the new color definitions to the display. */ if(pgx_flush_colors(pgx, 0, pgx->color->ncol)) return 1; /* * Start with the foreground color set to white. */ if(pgx_set_ci(pgx, 1)) return 1; /* * Record the color-cells as allocated. */ pgx->color->initialized = 1; }; return 0; } /*....................................................................... * Return the color representation of a given color index. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * rbuf float * The return array passed from GREXEC. * nbuf int * The output number of float results for GREXEC. */ #ifdef __STDC__ void pgx_get_rgb(PgxWin *pgx, float *rbuf, int *nbuf) #else void pgx_get_rgb(pgx, rbuf, nbuf) PgxWin *pgx; float *rbuf; int *nbuf; #endif { if(pgx_ready(pgx, PGX_NEED_COLOR)) { int ci = (int) (rbuf[0] + 0.5); rbuf[1] = (float) pgx->color->xcolor[ci].red / (float) PGX_COLORMULT; rbuf[2] = (float) pgx->color->xcolor[ci].green / (float) PGX_COLORMULT; rbuf[3] = (float) pgx->color->xcolor[ci].blue / (float) PGX_COLORMULT; } else { rbuf[1] = rbuf[2] = rbuf[3] = 0; }; *nbuf = 4; return; } /*....................................................................... * Flush color-representation changes made by xw_set_rgb() to the window. * This updates the window colormap. If color index 0 is changed * then the background color is also updated. * * Input: * pgx PgxWin * The PGPLOT window context. * ci_start int The first color index to update. * ncol int The number of colors to update. * Color indexes ci_state -> ci_start + ncol - 1 will * be updated. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_flush_colors(PgxWin *pgx, int ci_start, int ncol) #else static int pgx_flush_colors(pgx, ci_start, ncol) PgxWin *pgx; int ci_start; int ncol; #endif { if(pgx_ready(pgx, PGX_NEED_COLOR) && !pgx->color->monochrome) { /* * If the range of color indexes is invalid, warn the user and * then arrange to update the whole colormap. */ if(ci_start < 0 || ci_start + ncol - 1 >= pgx->color->ncol) { fprintf(stderr, "%s: pgx_flush_colors: color indexes out of range.\n", PGX_IDENT); ci_start = 0; ncol = pgx->color->ncol; }; /* * Are there any colors to be updated? */ if(ncol > 0) { XColor *xc = &pgx->color->xcolor[ci_start]; unsigned long *pixel = &pgx->color->pixel[ci_start]; /* * Allocate shared colorcells? */ if(pgx->color->readonly) { if(pgx_readonly_colors(pgx, ncol, xc, pixel)) return 1; /* * Modify existing read/write colorcells. */ } else { XStoreColors(pgx->display, pgx->color->cmap, xc, ncol); }; /* * Device error? */ if(pgx->bad_device) return 1; /* * Update the background color? */ if(ci_start == 0 && pgx->window != None) XSetWindowBackground(pgx->display, pgx->window, pixel[0]); }; }; return pgx->bad_device!=0; } /*....................................................................... * This is a front end to pgx_flush_colors() to be used when pgplot has * the window open and there are buffered colormap updates from previous * pgscr() opcodes. * * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_update_colors(PgxWin *pgx) #else static int pgx_update_colors(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; /* * Are there any colors to be updated? */ if(state->color.nbuff > 0) { if(pgx_flush_colors(pgx, state->color.sbuff, state->color.nbuff)) return 1; /* * Reset buffer pointers. */ state->color.nbuff = 0; state->color.sbuff = 0; }; }; return 0; } /*....................................................................... * Clear a PGPLOT window and (if allocated) the associated pixmap, to * the background color of the window. This function may be called * before pgx_open() is called. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_clear_window(PgxWin *pgx) #else int pgx_clear_window(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_WINDOW)) { /* * Clear the window itself. */ if(pgx->clip.doclip) { pgx_clear_area(pgx, pgx->clip.xmin, pgx->clip.ymin, (pgx->clip.xmax - pgx->clip.xmin + 1), (pgx->clip.ymax - pgx->clip.ymin + 1)); } else { XClearWindow(pgx->display, pgx->window); }; if(pgx->bad_device) return 1; /* * Flush any defered readonly color-cell updates. */ if(pgx_update_colors(pgx)) return 1; /* * Fill the pixmap with the background color. */ if(pgx_ready(pgx, PGX_NEED_COLOR | PGX_NEED_PIXMAP)) { Window root; int x, y; unsigned width, height, border, depth; /* * Determine the size of the pixmap. */ XGetGeometry(pgx->display, pgx->pixmap, &root, &x, &y, &width, &height, &border, &depth); /* * Clear the pixmap by drawing an opaque rectangle over it in the background * color. Use the exposure graphical context to avoid changing the * current foreground color and to allow this function to be called * before pgx_open(). */ XSetForeground(pgx->display, pgx->expose_gc, pgx->color->pixel[0]); XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, 0, 0, width, height); if(pgx->bad_device) return 1; /* * Mark the pixmap as unmodified. */ if(pgx->state) pgx->state->update.modified = 0; }; XFlush(pgx->display); if(pgx->bad_device) return 1; }; return pgx->bad_device ? 1 : 0; } /*....................................................................... * Return the device resolution in pixels per inch. This can be used * to implement PGPLOT opcode 3. * If pgx==NULL or pgx->display==NULL or pgx->bad_device!=0, then dummy * values will be returned. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * xpix_per_inch float * The number of pixels per inch along X. * ypix_per_inch float * The number of pixels per inch along Y. */ #ifdef __STDC__ void pgx_get_resolution(PgxWin *pgx, float *xpix_per_inch, float *ypix_per_inch) #else void pgx_get_resolution(pgx, xpix_per_inch, ypix_per_inch) PgxWin *pgx; float *xpix_per_inch; float *ypix_per_inch; #endif { if(pgx && pgx->display && !pgx->bad_device) { Display *display = pgx->display; int screen = DefaultScreen(display); unsigned int d_pix_width = DisplayWidth(display, screen); unsigned int d_pix_height = DisplayHeight(display, screen); unsigned int d_mm_width = DisplayWidthMM(display, screen); unsigned int d_mm_height = DisplayHeightMM(display, screen); /* * Determine the device resolution in pixels per inch. */ if(xpix_per_inch) *xpix_per_inch = 25.4 * ((double)d_pix_width / (double)d_mm_width); if(ypix_per_inch) *ypix_per_inch = 25.4 * ((double)d_pix_height / (double)d_mm_height); return; } else { if(xpix_per_inch) *xpix_per_inch = 1.0; if(ypix_per_inch) *ypix_per_inch = 1.0; }; return; } /*....................................................................... * Return the default size of the plot area in the form required by * PGPLOT opcode 6. * * If pgx==NULL, pgx->display==NULL or pgx->bad_device!=0, then specified * default values will be returned. * * Input: * pgx PgxWin * The PGPLOT window context. * d_width unsigned The default width to be specified if the * device is not open or is in an innapropriate * state. * d_height unsigned The default height to be specified if the * device is not open or is in an innapropriate * state. * Input/Output: * rbuf float * The return array passed from GREXEC. * nbuf int * The output number of float results for GREXEC. */ #ifdef __STDC__ void pgx_def_size(PgxWin *pgx, unsigned d_width, unsigned d_height, float *rbuf, int *nbuf) #else void pgx_def_size(pgx, d_width, d_height, rbuf, nbuf) PgxWin *pgx; unsigned d_width; unsigned d_height; float *rbuf; int *nbuf; #endif { /* * Set invariants. */ rbuf[0] = 0.0; rbuf[2] = 0.0; *nbuf = 4; /* * If we have sufficient information, return the current size of the * window excluding margins. */ if(pgx && pgx->display && !pgx->bad_device) { XWindowAttributes attr; XGetWindowAttributes(pgx->display, pgx->window, &attr); if(!pgx->bad_device) { rbuf[1] = (float) (attr.width - 2 * pgx->xmargin); rbuf[3] = (float) (attr.height - 2 * pgx->ymargin); if(rbuf[1] > 2 && rbuf[3] > 2) return; }; }; /* * If the device is not yet open, or if an error occured above, substitute * the default dimensions. */ rbuf[1] = d_width; rbuf[3] = d_height; return; } /*....................................................................... * Start a new page of a specified size. This includes resizing the * window and pixmap if necessary and clearing them. It also includes * initializing pgx->state->geom to reflect the size of the pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_begin_picture(PgxWin *pgx, float *rbuf) #else void pgx_begin_picture(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; /* * Determine the device resolution. */ pgx_get_resolution(pgx, &state->geom.xpix_per_inch, &state->geom.ypix_per_inch); /* * Determine the X and Y axis margins. */ state->geom.xmargin = pgx->xmargin; state->geom.ymargin = pgx->ymargin; /* * Convert the passed max X and Y coordinates into the total width of the * new window and pixmap. Add margins to the requested area. */ state->geom.width = (int) (rbuf[0] + 0.5) + 2 * state->geom.xmargin; state->geom.height = (int) (rbuf[1] + 0.5) + 2 * state->geom.ymargin; /* * Record the coordinate bounds of the required window area. */ state->geom.xmin = state->geom.xmargin; state->geom.xmax = state->geom.width - state->geom.xmargin; state->geom.ymin = state->geom.ymargin; state->geom.ymax = state->geom.height - state->geom.ymargin; /* * Resize the window if necessary. */ if(!pgx->bad_device) { XWindowAttributes attr; XGetWindowAttributes(pgx->display, pgx->window, &attr); if(!pgx->bad_device) if(pgx->resize_fn && (attr.width != state->geom.width || attr.height != state->geom.height)) { (*pgx->resize_fn)(pgx, state->geom.width, state->geom.height); }; }; /* * If a pixmap exists and has a different size to that requested, * delete it. */ if(!pgx->bad_device && pgx->pixmap != None) { Window root; int x, y; unsigned width, height, border, depth; /* * Determine the size of the existing pixmap. */ XGetGeometry(pgx->display, pgx->pixmap, &root, &x, &y, &width, &height, &border, &depth); /* * Delete it if it has the wrong size. */ if(width != state->geom.width || height != state->geom.height) { XFreePixmap(pgx->display, pgx->pixmap); pgx->pixmap = None; }; }; /* * Create a new pixmap if necessary. */ if(!pgx->bad_device && pgx->pixmap==None) { if(!pgx->new_pixmap_fn) pgx->new_pixmap_fn = pgx_new_pixmap; (*pgx->new_pixmap_fn)(pgx, state->geom.width, state->geom.height); }; }; /* * Clear the window and pixmap. */ pgx_clear_window(pgx); /* * Reset the scroll and pan offsets. */ pgx_scroll(pgx, 0, 0); return; } /*....................................................................... * Allocate a new Pixmap for a PGPLOT window of a given size. * Note that pgx->pixmap should be deleted and assigned None before * this function is called. * * Input: * pgx PgxWin * The PGPLOT window context. * width unsigned The required width of the pixmap (pixels). * height unsigned The required height of the pixmap (pixels). */ #ifdef __STDC__ void pgx_new_pixmap(PgxWin *pgx, unsigned width, unsigned height) #else void pgx_new_pixmap(pgx, width, height) PgxWin *pgx; unsigned width; unsigned height; #endif { if(pgx_ready(pgx, PGX_NEED_COLOR | PGX_NEED_WINDOW)) { /* * Bracket the pixmap acquisition with pgx_start/end_error() calls, to * determine whether any allocation errors occur. */ pgx_start_error_watch(pgx); pgx->pixmap = XCreatePixmap(pgx->display, pgx->window, width, height, (unsigned) pgx->color->vi->depth); if(pgx_end_error_watch(pgx) || pgx->pixmap==None) { fprintf(stderr, "%s: Failed to allocate %dx%d pixmap.\n", PGX_IDENT, width, height); pgx->pixmap = None; }; }; return; } /*....................................................................... * Change the appearance and position of specific graphical augmentations * to the cursor. * * Input: * pgx PgxWin * The PGPLOT window context. * ci int The color index to use when drawing the cursor, * or -1 to select the current foreground color. * type int A cursor type from: * PGX_NORM_CURSOR - No augmentation will be drawn. * PGX_LINE_CURSOR - Line cursor between rbeg and rend. * PGX_RECT_CURSOR - Rectangular cursor with opposing * vertices at rbeg and rend. * PGX_VLINE_CURSOR - Vertical line cursor at x=rbeg[0]. * PGX_HLINE_CURSOR - Horizontal line cursor at y=rbeg[1]. * PGX_CROSS_CURSOR - Cross-hair cursor at rbeg[0],rbeg.[1] * warp int If true, the cursor will be warped to rbeg when it * first enters the window. * rbeg float * The PGPLOT x,y device coordinates of the origin * of the cursor, as rbeg[0]=x and rbeg[1]=y. * This can be NULL for type==PGX_NORM_CURSOR. * rend float * The PGPLOT x,y device coordinates of the end-point * of the cursor, as rend[0]=x and rend[1]=y. This * can be NULL for cursor types that only need rbeg. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_cursor(PgxWin *pgx, int ci, int type, int warp, float *rbeg, float *rend) #else int pgx_set_cursor(pgx, ci, type, warp, rbeg, rend) PgxWin *pgx; int ci; int type; int warp; float *rbeg; float *rend; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; state->cursor.type = PGX_NORM_CURSOR; state->cursor.warp = warp; /* * Record the cursor coordinates according to cursor type. */ switch(type) { case PGX_NORM_CURSOR: break; case PGX_LINE_CURSOR: case PGX_RECT_CURSOR: case PGX_YRNG_CURSOR: case PGX_XRNG_CURSOR: if(rbeg && rend) { state->cursor.type = type; pgx_xy_to_XPoint(pgx, rbeg, &state->cursor.vbeg); pgx_xy_to_XPoint(pgx, rend, &state->cursor.vend); }; break; case PGX_HLINE_CURSOR: case PGX_VLINE_CURSOR: case PGX_CROSS_CURSOR: if(rbeg) { state->cursor.type = type; pgx_xy_to_XPoint(pgx, rbeg, &state->cursor.vbeg); }; break; }; /* * Establish a color for drawing the cursor. */ if(type != PGX_NORM_CURSOR) { unsigned long pixel; /* The colormap pixel to draw with */ if(ci < 0) pixel = state->gcv.foreground; /* The current foreground color */ else if(ci < pgx->color->ncol) pixel = pgx->color->pixel[ci]; /* The specified color index */ else pixel = pgx->color->pixel[1]; /* Out-of range, so use color index 1 */ XSetForeground(pgx->display, state->cursor.gc, pixel); }; return pgx->bad_device!=0; }; return 1; } /*....................................................................... * If the cursor is currently marked as having been drawn, redraw it to * account for damage from expose events or pgplot drawing operations * that have taken place since the cursor was last drawn. * * Input: * pgx PgxWin * The PGPLOT window context. * rbeg float * The PGPLOT x,y device coordinates of the origin * of the cursor, as rbeg[0]=x and rbeg[1]=y. * This can be NULL for type==PGX_NORM_CURSOR. * rend float * The PGPLOT x,y device coordinates of the end-point * of the cursor, as rend[0]=x and rend[1]=y. This * can be NULL for cursor types that only need rbeg. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_refresh_cursor(PgxWin *pgx) #else int pgx_refresh_cursor(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; if(state->cursor.drawn && pgx_draw_cursor(pgx)) return 1; }; return 0; } /*....................................................................... * Augment the X cursor with non-destructive line graphics by drawing * the graphics directly to the X window instead of to the pixmap. THe * underlying graphics can then be completely restored from the pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_draw_cursor(PgxWin *pgx) #else int pgx_draw_cursor(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; XWcursor *cursor = &state->cursor; int ymin, ymax; int xmin, xmax; /* * Convert from pixmap coordinates to window coordinates. */ XPoint vbeg; XPoint vend; pgx_pixmap_to_window(pgx, &cursor->vbeg, &vbeg); pgx_pixmap_to_window(pgx, &cursor->vend, &vend); /* * Get the drawable limits of the window. */ if(pgx->clip.doclip) { xmin = pgx->clip.xmin; xmax = pgx->clip.xmax; ymin = pgx->clip.ymin; ymax = pgx->clip.ymax; } else { xmin = 0; xmax = (int)state->geom.width - 1; ymin = 0; ymax = (int)state->geom.height - 1; }; /* * Record the fact that the cursor is being drawn. */ cursor->drawn = 1; /* * Draw the requested cursor augmentation graphics. */ switch(cursor->type) { case PGX_NORM_CURSOR: default: break; case PGX_LINE_CURSOR: XDrawLine(pgx->display, pgx->window, cursor->gc, vbeg.x, vbeg.y, vend.x, vend.y); break; case PGX_RECT_CURSOR: /* Draw a rectangle */ { int x = vbeg.xdisplay, pgx->window, cursor->gc, x, y, width, height); }; break; case PGX_YRNG_CURSOR: /* Two horizontal lines */ XDrawLine(pgx->display, pgx->window, cursor->gc, xmin, vend.y, xmax, vend.y); if(pgx->bad_device) return 1; XDrawLine(pgx->display, pgx->window, cursor->gc, xmin, vbeg.y, xmax, vbeg.y); break; case PGX_XRNG_CURSOR: /* Two vertical lines */ XDrawLine(pgx->display, pgx->window, cursor->gc, vend.x, ymin, vend.x, ymax); if(pgx->bad_device) return 1; XDrawLine(pgx->display, pgx->window, cursor->gc, vbeg.x, ymin, vbeg.x, ymax); break; case PGX_HLINE_CURSOR: /* One horizontal line through the cursor */ XDrawLine(pgx->display, pgx->window, cursor->gc, xmin, vend.y, xmax, vend.y); break; case PGX_VLINE_CURSOR: /* One vertical line through the cursor */ XDrawLine(pgx->display, pgx->window, cursor->gc, vend.x, ymin, vend.x, ymax); break; case PGX_CROSS_CURSOR: /* Cross hair */ XDrawLine(pgx->display, pgx->window, cursor->gc, xmin, vend.y, xmax, vend.y); if(pgx->bad_device) return 1; XDrawLine(pgx->display, pgx->window, cursor->gc, vend.x, ymin, vend.x, ymax); break; }; XFlush(pgx->display); return pgx->bad_device != 0; }; return 1; } /*....................................................................... * Erase graphics drawn by pgx_draw_cursor() by restoring the damaged * region from the underlying pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_erase_cursor(PgxWin *pgx) #else int pgx_erase_cursor(pgx) PgxWin *pgx; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; XWcursor *cursor = &state->cursor; /* * Convert from pixmap coordinates to window coordinates. */ XPoint vbeg; XPoint vend; pgx_pixmap_to_window(pgx, &cursor->vbeg, &vbeg); pgx_pixmap_to_window(pgx, &cursor->vend, &vend); /* * Record the erasure. */ cursor->drawn = 0; /* * Erase the cursor. */ switch(cursor->type) { case PGX_NORM_CURSOR: default: break; case PGX_LINE_CURSOR: /* Line cursor */ if(pgx_restore_line(pgx, vbeg.x, vbeg.y, vend.x, vend.y)) return 1; break; case PGX_RECT_CURSOR: /* Rectangle cursor */ if(pgx_restore_line(pgx, vbeg.x, vbeg.y, vbeg.x, vend.y) || pgx_restore_line(pgx, vbeg.x, vend.y, vend.x, vend.y) || pgx_restore_line(pgx, vend.x, vend.y, vend.x, vbeg.y) || pgx_restore_line(pgx, vend.x, vbeg.y, vbeg.x, vbeg.y)) return 1; break; case PGX_YRNG_CURSOR: /* Two horizontal lines */ if(pgx_restore_line(pgx, 0, vend.y, (int)state->geom.width-1, vend.y) || pgx_restore_line(pgx, 0, vbeg.y, (int)state->geom.width-1,vbeg.y)) return 1; break; case PGX_XRNG_CURSOR: /* Two vertical lines */ if(pgx_restore_line(pgx, vend.x, 0, vend.x, (int)state->geom.height-1) || pgx_restore_line(pgx, vbeg.x, 0, vbeg.x, (int)state->geom.height-1)) return 1; break; case PGX_HLINE_CURSOR: /* One horizontal line through the cursor */ if(pgx_restore_line(pgx, 0, vend.y, (int)state->geom.width-1,vend.y)) return 1; break; case PGX_VLINE_CURSOR: /* One vertical line through the cursor */ if(pgx_restore_line(pgx, vend.x, 0, vend.x, (int)state->geom.height-1)) return 1; break; case PGX_CROSS_CURSOR: /* Cross hair */ if(pgx_restore_line(pgx, 0, vend.y, (int)state->geom.width-1, vend.y) || pgx_restore_line(pgx, vend.x, 0, vend.x, (int)state->geom.height-1)) return 1; break; }; return pgx->bad_device != 0; }; return 1; } /*....................................................................... * Restore the pixels under a given line. * * Input: * pgx PgxWin * The PGPLOT window context. * xa, ya int The start pixel of the line (window coordinates). * xb, yb int The end pixel of the line (window coordinates). * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_restore_line(PgxWin *pgx, int xa, int ya, int xb, int yb) #else static int pgx_restore_line(pgx, xa, ya, xb, yb) PgxWin *pgx; int xa; int ya; int xb; int yb; #endif { int xlen = xb - xa; /* X-axis displacement of line */ int ylen = yb - ya; /* Y-axis displacement of line */ int xmin,xmax; /* Min/max X-axis end points */ int ymin,ymax; /* Min/max Y-axis end points */ #define PIXINC 51 /* * Device error? */ if(pgx->bad_device) return 1; /* * Get sorted versions of xa and xb. */ if(xlen > 0) { xmin = xa; xmax = xb; } else { xmin = xb; xmax = xa; }; /* * Get sorted versions of ya and yb. */ if(ylen > 0) { ymin = ya; ymax = yb; } else { ymin = yb; ymax = ya; }; /* * Vertical line? */ if(xlen==0) { pgx_copy_area(pgx, (int)(xmin + pgx->scroll.x), (int)(ymin + pgx->scroll.y), (unsigned) 1, (unsigned) (ymax-ymin+1), xmin, ymin); } /* * Horizontal line? */ else if(ylen==0) { pgx_copy_area(pgx, (int)(xmin + pgx->scroll.x), (int)(ymin + pgx->scroll.y), (unsigned) (xmax-xmin+1), (unsigned) 1, xmin, ymin); } /* * Diagonal line encompasing fewer x-axis lines that y-axis lines? */ else if(abs(xlen) <= abs(ylen)) { int x; /* The X coordinate of the line of pixels being drawn */ int y1,y2; /* The start and end Y coordinates of the pixel line */ double yperx = (double) ylen / (double) xlen; double yhalf = 0.5 * yperx; /* Y-step over half a pixel */ double ydelt = (PIXINC+0.5) * yperx; /* Y-step over PIXINC+0.5 pixels */ double ylo = yperx > 0 ? yhalf : -ydelt; double yhi = yperx > 0 ? ydelt : -yhalf; /* * Draw the block of pixels that encompases the line between X-axis * pixels the outer edges of pixels x -> x+PIXINC, for each consecutive * block of PIXINC pixels along X. */ for(x=xmin; x <= xmax; x += PIXINC+1) { double ycent = ya + (x - xa) * yperx; y1 = (int)(ycent - ylo); /* Note round-down semantics */ y2 = (int)(ycent + yhi+0.5);/* Note round-up semantics */ pgx_copy_area(pgx, (int)(x + pgx->scroll.x), (int)(y1 + pgx->scroll.y), (unsigned) (PIXINC+1), (unsigned) (y2-y1+1), x, y1); }; /* * Diagonal line encompasing fewer y-axis lines that x-axis lines? */ } else { int y; /* The Y coordinate of the line of pixels being drawn */ int x1,x2; /* The start and end X coordinates of the pixel line */ double xpery = (double) xlen / (double) ylen; double xhalf = 0.5 * xpery; /* X-step over half a pixel */ double xdelt = (PIXINC+0.5) * xpery; /* X-step over PIXINC+0.5 pixels */ double xlo = xpery > 0 ? xhalf : -xdelt; double xhi = xpery > 0 ? xdelt : -xhalf; /* * Draw the block of pixels that encompases the line between Y-axis * pixels the outer edges of pixels y -> y+PIXINC, for each consecutive * block of PIXINC pixels along Y. */ for(y=ymin; y <= ymax; y += PIXINC+1) { double xcent = xa + (y - ya) * xpery; x1 = (int)(xcent - xlo); /* Note round-down semantics */ x2 = (int)(xcent + xhi+0.5);/* Note round-up semantics */ pgx_copy_area(pgx, (int)(x1 + pgx->scroll.x), (int)(y + pgx->scroll.y), (unsigned) (x2-x1+1), (unsigned) (PIXINC+1), x1, y); }; }; /* * Check for device errors. */ if(pgx->bad_device) return 1; return 0; } /*....................................................................... * When the cursor is active, this function should be called whenever * one of the following event types are received. * * ButtonPress, KeyPress, MotionNotify, EnterWindow, LeaveWindow. * * In addition, Expose events will be handled if presented. Other event * types are quietly ignored. * * Input: * pgx PgxWin * The PGPLOT window context. * event XEvent * The X input event to be processed. * Input/Output: * rbuf float * If event->type is ButtonPress, KeyPress or * MotionNotify and rbuf!=NULL then the device * coordinates of the input event will be encoded * in PGPLOT x,y device coordinates as rbuf[0]=x * and rbuf[1]=y. * key char * If key!=NULL then: * 1. If the event is a key-press or key-release * event and the key is a single-ascii * character then *key will contain that * character. * 2. If the event is a button-press or * button-release event then the button will be * encoded as characters in *key as: * Button 1 => 'A', * Button 2 => 'D', * Button 3 => 'X'. * 3. Otherwise *key='\0'. * Output: * return int 0 - No position selected. * 1 - rbuf and key contain the latest cursor * selection details. */ #ifdef __STDC__ int pgx_cursor_event(PgxWin *pgx, XEvent *event, float *rbuf, char *key) #else int pgx_cursor_event(pgx, event, rbuf, key) PgxWin *pgx; XEvent *event; float *rbuf; char *key; #endif { char ret_key = '\0'; /* The key to be returned */ XPoint coord; /* Pointer coordinate */ int have_posn = 0; /* If true, a position has been encoded in coord */ /* * Cursor ready? */ if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { PgxState *state = pgx->state; XWcursor *cursor = &state->cursor; /* * Place the pointer position in coord.x,y. */ switch(event->type) { case Expose: if(pgx_expose(pgx, event)) return 0; break; case KeyPress: coord.x = event->xkey.x; coord.y = event->xkey.y; /* * Get the ASCII encoding associated with the key. */ { char buffer[10]; /* Buffer to read key definition into */ KeySym keysym; /* Key code of pressed keyboard key */ int nret; /* The number of characters returned in buffer[]*/ nret = XLookupString(&event->xkey, buffer, (int) (sizeof(buffer)/sizeof(char)), &keysym, NULL); if(pgx->bad_device) return 0; /* * Ignore modifier keys and all but single character keys. */ if(nret==1 && (keysym < XK_Shift_L || keysym > XK_Hyper_R)) { ret_key = buffer[0]; have_posn = 1; }; }; break; case ButtonPress: coord.x = event->xbutton.x; coord.y = event->xbutton.y; have_posn = 1; switch(event->xbutton.button) { case Button1: ret_key = 'A'; break; case Button2: ret_key = 'D'; break; default: ret_key = 'X'; break; }; break; case EnterNotify: /* * The cursor may still be drawn if a button was pressed when the * cursor was last moved out of the window. The resulting * passive grab will have continued to deliver motion events to * the PGPLOT window. */ if(pgx_erase_cursor(pgx)) return 0; /* * If the cursor is in the window, locate its position and record it * in pgx->state->cursor.vend. If this is the first time that the * cursor has been in the window and warping has been requested, * this also inolves pre-positioning the cursor. */ if(pgx_locate_cursor(pgx)) { /* * Draw the cursor if it isn't already drawn. */ if(pgx->bad_device || pgx_draw_cursor(pgx)) return 0; }; break; case LeaveNotify: if(pgx_erase_cursor(pgx)) return 0; break; case MotionNotify: /* * Discard all but the last MotionNotify event. */ while(XCheckWindowEvent(pgx->display, pgx->window, (long)(PointerMotionMask), event) == True); if(pgx->bad_device || pgx_erase_cursor(pgx)) return 0; /* * Erase the out-of-date cursor. */ if(pgx_erase_cursor(pgx)) return 0; /* * Convert from window coordinates to pixmap coordinates. */ cursor->vend.x = event->xmotion.x + pgx->scroll.x; cursor->vend.y = event->xmotion.y + pgx->scroll.y; /* * Redraw the cursor at the new position. */ if(pgx_draw_cursor(pgx)) return 0; break; default: break; }; /* * Convert new pointer coordinates to pgplot device coordinates. */ if(have_posn) { /* * Convert from window coordinates to pixmap coordinates. */ coord.x = coord.x + pgx->scroll.x; coord.y = coord.y + pgx->scroll.y; /* * Convert to PGPLOT device coordinates. */ if(rbuf) pgx_XPoint_to_xy(pgx, &coord, rbuf); if(key) *key = ret_key; return 1; }; }; return 0; } /*....................................................................... * Determine whether the cursor is within the plot window. If it is * and (cursor=&pgx->state->cursor) cursor->warp is true, warp the cursor * to cursor->vbeg then reset cursor->warp to 0. * Record the final position of the cursor in cursor->vend. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return int 0 - Cursor not in window. * 1 - Cursor is in window. */ #ifdef __STDC__ int pgx_locate_cursor(PgxWin *pgx) #else int pgx_locate_cursor(pgx) PgxWin *pgx; #endif { XPoint pointer; /* Pointer coordinates */ Window parent; /* The parent window */ /* * The following are all for use with XQueryPointer(). */ Window p_child; /* The child of pgx->window (None) */ int p_win_x, p_win_y; /* The pointer coordinates in pgx->window */ int p_root_x, p_root_y; /* The pointer coordinates in the root window */ Window p_root_win; /* The root window containing the cursor */ unsigned int p_mask; /* Bit mask of button states etc.. */ /* * Device error? */ if(pgx_ready(pgx, PGX_NEED_WINDOW | PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; XWcursor *cursor = &state->cursor; /* * Get the parent window. */ parent = pgx_parent_window(pgx); if(parent == None) return 0; /* * See if the pointer is currently in the PGPLOT window. */ XQueryPointer(pgx->display, parent, &p_root_win, &p_child, &p_root_x, &p_root_y, &p_win_x, &p_win_y, &p_mask); if(pgx->bad_device) return 0; if(p_child==pgx->window) { /* * Determine the current position of the pointer within the PGPLOT window. */ XQueryPointer(pgx->display, pgx->window, &p_root_win, &p_child, &p_root_x, &p_root_y, &p_win_x, &p_win_y, &p_mask); if(pgx->bad_device) return 0; /* * Record the pointer coordinates. */ pointer.x = p_win_x; pointer.y = p_win_y; /* * Warp the cursor? */ if(cursor->warp) { XWindowAttributes attr; /* Current window attributes */ XPoint warp_coord; /* The window coordinates to warp to */ /* * Query the current state of the window. */ XGetWindowAttributes(pgx->display, pgx->window, &attr); if(pgx->bad_device) return 0; /* * Convert the warp pixmap coordinates to window coordinates. */ pgx_pixmap_to_window(pgx, &cursor->vbeg, &warp_coord); /* * Disable subsequent warping. */ cursor->warp = 0; /* * Don't warp the cursor unless the warp target location is visible. */ if(warp_coord.x < 0 || warp_coord.x >= attr.width || warp_coord.y < 0 || warp_coord.y >= attr.height) { pgx_window_to_pixmap(pgx, &pointer, &cursor->vend); } else { XWarpPointer(pgx->display, None, pgx->window, 0, 0, 0, 0, warp_coord.x, warp_coord.y); if(pgx->bad_device) return 0; /* * Record the new coordinates. */ pgx_window_to_pixmap(pgx, &warp_coord, &cursor->vend); }; /* * Return the current position of the cursor without warping. */ } else { pgx_window_to_pixmap(pgx, &pointer, &cursor->vend); }; return 1; /* The pointer is in the window */ }; }; return 0; /* The pointer is not in the window */ } /*....................................................................... * Install a new event mask. This function can be used to add to remove * from or replace the existing event mask. When adding to or replacing * the existing event mask, care is taken to check for the addition of * events that X only allows one client to select. If these can not * be selected, they will silently be removed from the event mask. * The pertinent masks are: ButtonPressMask, SubstructureRedirectMask and * ResizeRedirectMask. * * Input: * pgx PgxWin * The PGPLOT window context. * oper int The operation to be performed, from: * PGX_ADD_EVENTS - Form a union of the existing * event mask and 'events'. * PGX_REM_EVENTS - Remove the events in 'events' * from the existing event mask. * PGX_SET_EVENTS - Replace the existing event * mask with 'events'. * events unsigned long The event mask to use as specified by 'oper'. * Output: * return unsigned long The old event mask. */ #ifdef __STDC__ unsigned long pgx_select_events(PgxWin *pgx, int oper, long events) #else unsigned long pgx_select_events(pgx, oper, events) PgxWin *pgx; int oper; long events; #endif { unsigned long incr_mask; /* The events to be added to the old mask */ unsigned long decr_mask; /* The events to be removed from the old mask */ unsigned long new_mask = 0; /* The new trial event mask */ unsigned long old_mask = 0; /* The old event mask to be returned */ /* * We need a window to select events from. */ if(pgx_ready(pgx, PGX_NEED_WINDOW)) { XWindowAttributes attr; /* Current window attributes */ /* * Get the current window attributes. */ XGetWindowAttributes(pgx->display, pgx->window, &attr); if(pgx->bad_device) return old_mask; /* * Record the existing event mask. */ old_mask = attr.your_event_mask; /* * Decompose the mask-update into a mask of events that need to be * added and a mask of events that need to be removed. */ switch(oper) { case PGX_SET_EVENTS: default: incr_mask = ~old_mask & events; decr_mask = ~events & old_mask; break; case PGX_ADD_EVENTS: incr_mask = ~old_mask & (old_mask | events); decr_mask = 0; break; case PGX_REM_EVENTS: incr_mask = 0; decr_mask = events; break; }; /* * Form a new mask from the old mask by removing the events in decr_mask * but adding only events from the incremental mask that do not have the * potential to cause protocol errors. */ new_mask = (old_mask & ~decr_mask) | (incr_mask & ~(unsigned long)(ButtonPressMask | SubstructureRedirectMask | ResizeRedirectMask)); /* * If the incremental event mask contains events that can only be selected * by one client at a time, we must try each one, one at a time and * only add the event to the final mask if it can be accomodated. */ if(incr_mask & ButtonPressMask) { pgx_start_error_watch(pgx); XSelectInput(pgx->display, pgx->window, (long) (new_mask | ButtonPressMask)); if(!pgx_end_error_watch(pgx)) new_mask |= ButtonPressMask; }; if(incr_mask & SubstructureRedirectMask) { pgx_start_error_watch(pgx); XSelectInput(pgx->display, pgx->window, (long) (new_mask | SubstructureRedirectMask)); if(!pgx_end_error_watch(pgx)) new_mask |= SubstructureRedirectMask; }; if(incr_mask & ResizeRedirectMask) { pgx_start_error_watch(pgx); XSelectInput(pgx->display, pgx->window, (long)(new_mask | ResizeRedirectMask)); if(!pgx_end_error_watch(pgx)) new_mask |= ResizeRedirectMask; }; /* * Try to select the new mask. */ pgx_start_error_watch(pgx); XSelectInput(pgx->display, pgx->window, (long) new_mask); if(pgx_end_error_watch(pgx)) { fprintf(stderr, "pgx_select_events: Error selecting events.\n"); return old_mask; }; }; return old_mask; } /*....................................................................... * Perform a blocking cursor read to implement the read-cursor PGPLOT * driver opcode. The function will not return until the user presses a * pointer button or keyboard key within the window. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. * On input: * rbuf[0] = Initial X position of cursor. * rbuf[1] = Initial Y position of cursor. * rbuf[2] = Reference X position for rubber-banding. * rbuf[3] = Reference Y position for rubber-banding. * rbuf[4] = Cursor banding mode as enumerated in * pgxwin.h as PGX_*_CURSOR. * rbuf[5] = Pre-position cursor if > 0. * On output: * rbuf[0] = X position of cursor. * rbuf[1] = Y position of cursor. * chr char * On output *chr will be assigned the character * associated with the key or button that the user * typed. * nbuf int * On output this will be set to 2 to tell PGPLOT that * two elements of rbuf are being returned. * lchr int * On output this will be set to 1 to tell PGPLOT that * chr[] contains a single character. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_read_cursor(PgxWin *pgx, float *rbuf, char *chr, int *nbuf, int *lchr) #else int pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr) PgxWin *pgx; float *rbuf; char *chr; int *nbuf; int *lchr; #endif { int waserr = 0; /* * Preset predetermined return values. */ if(nbuf) *nbuf = 2; if(lchr) *lchr = 1; if(chr) *chr = '\0'; /* * Read the cursor if possible. */ if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) { unsigned long old_mask; /* * Raise the cursor. */ if(pgx_set_cursor(pgx, -1, (int)(rbuf[4]+0.5), (int)(rbuf[5]+0.5)>0, &rbuf[2], &rbuf[0])) return 1; /* * Draw the cursor if it is in the window. */ pgx_locate_cursor(pgx); /* * Augment the event mask with the events that we need. */ old_mask = pgx_select_events(pgx, PGX_ADD_EVENTS, (long) (ExposureMask | KeyPressMask | ButtonPressMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask)); /* * Handle the above events until the user selects a position by pressing * a mouse button or key. */ waserr = waserr || pgx_handle_cursor(pgx, rbuf, chr); /* * Remove any cursor augmentation. */ waserr = waserr || pgx_erase_cursor(pgx) || pgx_set_cursor(pgx, 0, PGX_NORM_CURSOR, 0, NULL, NULL); /* * Reinstall the original event mask. */ pgx_select_events(pgx, PGX_SET_EVENTS, (long) old_mask); }; return waserr != 0; } /*....................................................................... * This is the private function of pgx_read_cursor() which maintains * the display of the cursor and returns when a valid keyboard or * button-press event has been received. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * rbuf float * The return position array. * key char * The key that caused the cursor to be selected. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_handle_cursor(PgxWin *pgx, float *rbuf, char *key) #else static int pgx_handle_cursor(pgx, rbuf, key) PgxWin *pgx; float *rbuf; char *key; #endif { XEvent event; /* * Discard un-handled ButtonPress, KeyPress and MotionNotify events * without blocking. */ while(XCheckWindowEvent(pgx->display, pgx->window, (long) (ButtonPressMask | KeyPressMask | PointerMotionMask), &event)) ; if(pgx->bad_device) return 1; /* * Wait for further events. */ while(!pgx->bad_device) { XWindowEvent(pgx->display, pgx->window, (long) (ExposureMask | KeyPressMask | ButtonPressMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask), &event); if(pgx->bad_device) return 1; if(pgx_cursor_event(pgx, &event, rbuf, key) && *key!='\0') return 0; }; return 1; } /*....................................................................... * Limit pixmap coordinates to lie within the pixmap area. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * coord XPoint * The coordinates to be modified. */ #ifdef __STDC__ static void pgx_limit_pcoords(PgxWin *pgx, XPoint *coord) #else static void pgx_limit_pcoords(pgx, coord) PgxWin *pgx; XPoint *coord; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { PgxState *state = pgx->state; if(coord->x < 0) coord->x = 0; if(coord->y < 0) coord->y = 0; if(coord->x >= state->geom.width) coord->x = state->geom.width - 1; if(coord->y >= state->geom.height) coord->y = state->geom.height - 1; }; return; } /*....................................................................... * Limit window coordinates to lie within the drawable window area. * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * coord XPoint * The coordinates to be modified. */ #ifdef __STDC__ static void pgx_limit_wcoords(PgxWin *pgx, XPoint *coord) #else static void pgx_limit_wcoords(pgx, coord) PgxWin *pgx; XPoint *coord; #endif { if(pgx_ready(pgx, 0) && pgx->clip.doclip) { if(coord->x >= pgx->clip.xmax) coord->x = pgx->clip.xmax; if(coord->y >= pgx->clip.ymax) coord->y = pgx->clip.ymax; if(coord->x < pgx->clip.xmin) coord->x = pgx->clip.xmin; if(coord->y < pgx->clip.ymin) coord->y = pgx->clip.ymin; }; return; } /*....................................................................... * Convert from scrolled window coordinates to pixmap coordinates. * The pixmap coordinates will be limited to the bounds of the pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * w_coord XPoint * The window coordinate to be converted. * Input/Output: * p_coord XPoint * The resulting pixmap coordinates. */ #ifdef __STDC__ static void pgx_window_to_pixmap(PgxWin *pgx, XPoint *w_coord, XPoint *p_coord) #else static void pgx_window_to_pixmap(pgx, w_coord, p_coord) PgxWin *pgx; XPoint *w_coord; XPoint *p_coord; #endif { if(pgx) { p_coord->x = w_coord->x + pgx->scroll.x; p_coord->y = w_coord->y + pgx->scroll.y; } else { p_coord->x = w_coord->x; p_coord->y = w_coord->y; }; pgx_limit_pcoords(pgx, p_coord); return; } /*....................................................................... * Convert from pixmap coordinates to scrolled window coordinates. * The coordinates will be bounded to the size of the pixmap * before the conversion and bounded to the drawable area of the * pixmap after the conversion. * * Input: * pgx PgxWin * The PGPLOT window context. * p_coord XPoint * The pixmap coordinate to be converted. * Input/Output: * w_coord XPoint * The resulting window coordinates. */ #ifdef __STDC__ static void pgx_pixmap_to_window(PgxWin *pgx, XPoint *p_coord, XPoint *w_coord) #else static void pgx_pixmap_to_window(pgx, p_coord, w_coord) PgxWin *pgx; XPoint *p_coord; XPoint *w_coord; #endif { if(pgx) { pgx_limit_pcoords(pgx, p_coord); w_coord->x = p_coord->x - pgx->scroll.x; w_coord->y = p_coord->y - pgx->scroll.y; pgx_limit_wcoords(pgx, w_coord); } else { w_coord->x = p_coord->x; w_coord->y = p_coord->y; }; return; } /*....................................................................... * Create and initialize an empty PGPLOT window context descriptor * at least up to the point at which it can safely be passed to * del_PgxWin(). * * Input: * display Display * The display to associate with the window. * screen int The screen to associate with the window. * name char * A name to refer to the window by. * resize_fn PgxResizeWindowFn The function to call when the window * needs resizing, or 0 if window resizing is to be * disallowed. * pixmap_fn PgxNewPixmapFn The function to call to allocate a new * pixmap. If no special action is required, * send 0 and pgx_new_pixmap will be substituted. * Output: * return PgxWin * The new container ready to be filled, or NULL * on error. */ #ifdef __STDC__ PgxWin *new_PgxWin(Display *display, int screen, void *context, char *name, PgxResizeWindowFn resize_fn, PgxNewPixmapFn pixmap_fn) #else PgxWin *new_PgxWin(display, screen, context, name, resize_fn, pixmap_fn) Display *display; int screen; void *context; char *name; PgxResizeWindowFn resize_fn; PgxNewPixmapFn pixmap_fn; #endif { PgxWin *pgx; /* The new descriptor */ /* * Check arguments. */ if(!display) { fprintf(stderr, "new_PgxWin: NULL Display intercepted.\n"); return NULL; }; /* * Allocate the container. */ pgx = (PgxWin *) malloc(sizeof(PgxWin)); if(!pgx) { fprintf(stderr, "new_PgxWin: Insufficient memory for new PGPLOT window.\n"); return NULL; }; /* * Before attemping anything that might fail, initialize the container * at least up to the point at which it can safely be passed to * del_PgxWin(). */ pgx->context = context; pgx->display = display; pgx->screen = screen; pgx->window = None; pgx->pixmap = None; pgx->expose_gc = NULL; pgx->bad_device = 0; pgx->name = NULL; pgx->xmargin = 0; pgx->ymargin = 0; pgx->color = NULL; pgx->clip.doclip = 0; pgx->clip.xmin = pgx->clip.xmax = 0; pgx->clip.ymin = pgx->clip.ymax = 0; pgx->resize_fn = resize_fn; pgx->new_pixmap_fn = pixmap_fn ? pixmap_fn : pgx_new_pixmap; pgx->old_handler = 0; pgx->state = NULL; /* * Allocate a copy of the specified name. */ if(!name) name = "pgxwin"; pgx->name = (char *) malloc(strlen(name) + 1); if(!pgx->name) { fprintf(stderr, "new_PgxWin: Insufficient memory to name window.\n"); return del_PgxWin(pgx); }; strcpy(pgx->name, name); /* * The rest of the initialization is driver-specific. */ return pgx; } /*....................................................................... * Delete a PgxWin PGPLOT window context container and its contents. * Note that it is the responsibility of the caller to keep a record of * and delete the window pgx->window and close the display pgx->display * when appropriate. * * Input: * pgx PgxWin * The container to be deleted. * Output: * return PgxWin * The deleted container (Always NULL). */ #ifdef __STDC__ PgxWin *del_PgxWin(PgxWin *pgx) #else PgxWin *del_PgxWin(pgx) PgxWin *pgx; #endif { if(pgx) { /* * Make sure that the window is closed to PGPLOT. * This deletes pgx->state and its contents. */ pgx_close(pgx); /* * Destroy the pixmap. */ if(pgx->display && pgx->pixmap != None) XFreePixmap(pgx->display, pgx->pixmap); /* * Discard the graphical context. */ if(pgx->display && pgx->expose_gc) XFreeGC(pgx->display, pgx->expose_gc); /* * Delete the colormap/visual context. */ pgx->color = del_PgxColor(pgx, pgx->color); /* * Release the memory taken by the window-name string. */ if(pgx->name) free(pgx->name); /* * Just in case an application continues to use this descriptor after * it has been free()'d mark it as bad. This isn't foolproof since the * next malloc() will probably reuse this memory, but anything that * might help track down such a lethal problem is worth doing. */ pgx->bad_device = 1; /* * Finally, free the container. */ free(pgx); }; return NULL; } /*....................................................................... * When copying the off-screen pixmap to the window this function * should be used in place of XCopyArea() [which it calls]. This function * clips the copied area to the dimensions of the window clipping * area in pgx->clip. * * Input: * px,py int The top-left corner of the area to be copied * from the pixmap. * w,h unsigned The width and height of the area to be copied. * wx,wy int The top-left corner of the destination area * in the window. */ #ifdef __STDC__ static int pgx_copy_area(PgxWin *pgx, int px, int py, unsigned w, unsigned h, int wx, int wy) #else static int pgx_copy_area(pgx, px, py, w, h, wx, wy) PgxWin *pgx; int px; int py; unsigned w; unsigned h; int wx; int wy; #endif { if(pgx_ready(pgx, PGX_NEED_WINDOW | PGX_NEED_PIXMAP)) { /* * Limit the copied area to the drawable area of the window as listed * in pgx->clip. * * First clip the destination X-axis extent to between pgx->clip.xmin and * pgx->clip.xmax and adjust the source coordinates to suit. */ if(pgx->clip.doclip) { long height = h; /* Signed version of h */ long width = w; /* Signed version of w */ if(wx < pgx->clip.xmin) { int xdiff = pgx->clip.xmin - wx; wx += xdiff; px += xdiff; width -= xdiff; }; if(wx + width - 1 > pgx->clip.xmax) width = pgx->clip.xmax - wx + 1; /* * Now clip the destination Y-axis extent to between pgx->clip.ymin and * pgx->clip.ymax and adjust the source coordinates to suit. */ if(wy < pgx->clip.ymin) { int ydiff = pgx->clip.ymin - wy; wy += ydiff; py += ydiff; height -= ydiff; }; if(wy + height - 1 > pgx->clip.ymax) height = pgx->clip.ymax - wy + 1; /* * Nothing visible? */ if(width <= 0 || height <= 0) return 0; w = width; h = height; }; /* * Perform the requested copy. */ XCopyArea(pgx->display, pgx->pixmap, pgx->window, pgx->expose_gc, px, py, w, h, wx, wy); }; return 0; } /*....................................................................... * When clearing a region of the window this function should be used in * place of XClearArea() [which it calls]. This function clips the copied * area to the dimensions of the window clipping area in pgx->clip. * * Input: * x,y int The top-left corner of the area to be cleared * in the window (window pixel coordinates). * w,h unsigned The width and height of the area to be cleared. */ #ifdef __STDC__ static int pgx_clear_area(PgxWin *pgx, int x, int y, unsigned w, unsigned h) #else static int pgx_clear_area(pgx, x, y, w, h) PgxWin *pgx; int x; int y; unsigned w; unsigned h; #endif { if(pgx_ready(pgx, PGX_NEED_WINDOW)) { /* * Limit the cleared area to the drawable area of the window as listed * in pgx->clip. * * First clip the destination X-axis extent to between pgx->clip.xmin and * pgx->clip.xmax. */ if(pgx->clip.doclip) { long height = h; /* Signed version of h */ long width = w; /* Signed version of w */ if(x < pgx->clip.xmin) { int xdiff = pgx->clip.xmin - x; x += xdiff; width -= xdiff; }; if(x + width - 1 > pgx->clip.xmax) width = pgx->clip.xmax - x + 1; /* * Now clip the destination Y-axis extent to between pgx->clip.ymin and * pgx->clip.ymax and adjust the source coordinates to suit. */ if(y < pgx->clip.ymin) { int ydiff = pgx->clip.ymin - y; y += ydiff; height -= ydiff; }; if(y + height - 1 > pgx->clip.ymax) height = pgx->clip.ymax - y + 1; /* * Nothing visible? */ if(width <= 0 || height <= 0) return 0; w = width; h = height; }; /* * Perform the requested clear. */ XClearArea(pgx->display, pgx->window, x, y, w, h, False); }; return 0; } /*....................................................................... * Change the background color of a window. * * Input: * pgx PgxWin * The PGPLOT window context. * xc XColor * The new background color. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_background(PgxWin *pgx, XColor *xc) #else int pgx_set_background(pgx, xc) PgxWin *pgx; XColor *xc; #endif { if(!xc) { fprintf(stderr, "%s: pgx_set_background: NULL xc argument.", PGX_IDENT); return 1; }; if(pgx_ready(pgx, PGX_NEED_COLOR)) { float r = (float) xc->red / PGX_COLORMULT; float g = (float) xc->green / PGX_COLORMULT; float b = (float) xc->blue / PGX_COLORMULT; /* * Register the desired color in pgx->color->xcolor[0]. */ if(pgx_set_rgb(pgx, 0, r, g, b)) return 1; /* * Flush the changed color to the X server. * If the allocated color cells are readonly, defer the update until * the next page. */ if((!pgx->color->readonly && pgx->state) ? pgx_update_colors(pgx) : pgx_flush_colors(pgx, 0, 1)) return 1; }; return 0; } /*....................................................................... * Change the foreground color of a window. * * Input: * pgx PgxWin * The PGPLOT window context. * xc XColor * The new foreground color. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_set_foreground(PgxWin *pgx, XColor *xc) #else int pgx_set_foreground(pgx, xc) PgxWin *pgx; XColor *xc; #endif { if(!xc) { fprintf(stderr, "%s: pgx_set_foreground: NULL xc argument.", PGX_IDENT); return 1; }; if(pgx_ready(pgx, PGX_NEED_COLOR)) { float r = (float) xc->red / PGX_COLORMULT; float g = (float) xc->green / PGX_COLORMULT; float b = (float) xc->blue / PGX_COLORMULT; /* * Register the desired color in pgx->color->xcolor[0]. */ if(pgx_set_rgb(pgx, 1, r, g, b)) return 1; /* * Flush the changed color to the X server. * If the allocated color cells are readonly, defer the update until * the next page. */ if((!pgx->color->readonly && pgx->state) ? pgx_update_colors(pgx) : pgx_flush_colors(pgx, 1, 1)) return 1; }; return 0; } /*....................................................................... * Return the width of the current pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * unsigned int The width of the pixmap, or 0 if no pixmap currently * exists. */ #ifdef __STDC__ unsigned pgx_pixmap_width(PgxWin *pgx) #else unsigned pgx_pixmap_width(pgx) PgxWin *pgx; #endif { if(!pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) return 0; return pgx->state->geom.width; } /*....................................................................... * Return the height of the current pixmap. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * unsigned int The height of the pixmap, or 0 if no pixmap currently * exists. */ #ifdef __STDC__ unsigned pgx_pixmap_height(PgxWin *pgx) #else unsigned pgx_pixmap_height(pgx) PgxWin *pgx; #endif { if(!pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP)) return 0; return pgx->state->geom.height; } /*....................................................................... * Convert from window pixel coordinates to PGPLOT device coordinates. * * Input: * pgx PgxWin * The PGPLOT window context. * x,y int The X window pixel coordinates. * Input/Output: * rbuf float * The return array for the X and Y device coordinates. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_win2dev(PgxWin *pgx, int x, int y, float *rbuf) #else int pgx_win2dev(pgx, x, y, rbuf) PgxWin *pgx; int x; int y; float *rbuf; #endif { if(!rbuf) { fprintf(stderr, "pgx_win2dev: NULL rbuf[].\n"); return 1; }; if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { XPoint coord; /* * Convert from window coordinates to pixmap coordinates. */ coord.x = x + pgx->scroll.x; coord.y = y + pgx->scroll.y; /* * Convert to PGPLOT device coordinates. */ pgx_XPoint_to_xy(pgx, &coord, rbuf); } else { rbuf[0] = rbuf[1] = 0.0; }; return 0; } /*....................................................................... * Convert from PGPLOT device coordinates to X window coordinates. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The PGPLOT X and Y device coordinates. * rbuf[0] = X device coordinate. * rbuf[1] = Y device coordinate. * Input/Output: * x,y int * The corresponding X window coordinates. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_dev2win(PgxWin *pgx, float *rbuf, int *x, int *y) #else int pgx_dev2win(pgx, rbuf, x, y) PgxWin *pgx; float *rbuf; int *x; int *y; #endif { if(!rbuf || !x || !y) { fprintf(stderr, "pgx_dev2win: NULL %s.\n", !rbuf ? "rbuf[]" : (!x ? "x":"y")); return 1; }; if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { XPoint coord; /* * Convert from PGPLOT device coordinates to pixmap coordinates. */ pgx_xy_to_XPoint(pgx, rbuf, &coord); /* * Convert from pixmap coordinates to window coordinates. */ *x = coord.x - pgx->scroll.x; *y = coord.y - pgx->scroll.y; } else { *x = *y = 0.0; }; return 0; } /*....................................................................... * Convert from PGPLOT device coordinates to PGPLOT world coordinates. * * Note that use of this function requires that opcode 27 be enabled and * set up to update the world-coordinate scaling via pgx_set_world(). * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * rbuf float * On input this should contain the PGPLOT device * x and y coordinates. On output it will contain the * corresponding world coordinates. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_dev2world(PgxWin *pgx, float *rbuf) #else int pgx_dev2world(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(!rbuf) { fprintf(stderr, "pgx_dev2world: NULL rbuf[].\n"); return 1; }; if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { XWworld *world = &pgx->state->world; /* * Convert device coordinates to world coordinates. */ rbuf[0] = (rbuf[0] - world->xoff) / world->xdiv; rbuf[1] = (rbuf[1] - world->yoff) / world->ydiv; } else { rbuf[0] = rbuf[1] = 0.0; }; return 0; } /*....................................................................... * Convert from PGPLOT world coordinates to PGPLOT device coordinates. * * Note that use of this function requires that opcode 27 be enabled and * set up to update the world-coordinate scaling via pgx_set_world(). * * Input: * pgx PgxWin * The PGPLOT window context. * Input/Output: * rbuf float * On input this should contain the PGPLOT world * x and y coordinates. On output it will contain the * corresponding PGPLOT device coordinates. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ int pgx_world2dev(PgxWin *pgx, float *rbuf) #else int pgx_world2dev(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(!rbuf) { fprintf(stderr, "pgx_world2dev: NULL rbuf[].\n"); return 1; }; if(pgx_ready(pgx, PGX_NEED_PGOPEN)) { XWworld *world = &pgx->state->world; /* * Convert world coordinates to device coordinates. */ rbuf[0] = rbuf[0] * world->xdiv + world->xoff; rbuf[1] = rbuf[1] * world->ydiv + world->yoff; } else { rbuf[0] = rbuf[1] = 0.0; }; return 0; } /*....................................................................... * Scroll a rectangular area vertically and/or horizontally. * * Input: * pgx PgxWin * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ void pgx_scroll_rect(PgxWin *pgx, float *rbuf) #else void pgx_scroll_rect(pgx, rbuf) PgxWin *pgx; float *rbuf; #endif { if(pgx_ready(pgx, PGX_NEED_PGOPEN | PGX_NEED_PIXMAP | PGX_NEED_COLOR)) { XPoint blc, trc; /* The bottom left and top right rectangle corners */ XPoint blc_orig, trc_orig; /* The vertices of the rectangle to be copied */ XPoint blc_dest, trc_dest; /* The vertices of the destination of the copy */ int dx, dy; /* The amounts to scroll right and down */ /* * Convert the rectangle vertices from PGPLOT coordinates to X coordinates. */ pgx_xy_to_XPoint(pgx, &rbuf[0], &blc); pgx_xy_to_XPoint(pgx, &rbuf[2], &trc); /* * Get the scroll offsets in X coordinates. */ dx = pgx_nint(rbuf[4]); dy = pgx_nint(-rbuf[5]); /* * Selected parts of the pixmap will need to be erased by drawing an * opaque rectangle over them in the background color. Establish * the background color in the exposure graphical context to avoid * changing the current foreground color. */ XSetForeground(pgx->display, pgx->expose_gc, pgx->color->pixel[0]); /* * If either scroll extent exceeds the length of the associated * axis, then fill the area with the background color. */ if(abs(dx) > trc.x - blc.x || abs(dy) > blc.y - trc.y) { /* * Fill the rectangle in the pixmap. */ XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, blc.x, trc.y, (unsigned)(trc.x-blc.x+1), (unsigned)(blc.y-trc.y+1)); } else { /* * Calculate the vertices of the source and destination rectangles to * be copied. */ blc_orig = blc_dest = blc; trc_orig = trc_dest = trc; if(dx > 0) { trc_orig.x = trc.x - dx; blc_dest.x = blc.x + dx; } else if(dx < 0) { blc_orig.x = blc.x - dx; trc_dest.x = trc.x + dx; }; if(dy > 0) { blc_orig.y = blc.y - dy; trc_dest.y = trc.y + dy; } else if(dy < 0) { trc_orig.y = trc.y - dy; blc_dest.y = blc.y + dy; }; /* * Constrain the coordinates to lie within the pixmap. */ pgx_limit_pcoords(pgx, &blc_orig); pgx_limit_pcoords(pgx, &blc_dest); pgx_limit_pcoords(pgx, &trc_orig); pgx_limit_pcoords(pgx, &trc_dest); /* * Scroll the rectangle to its shifted location. */ XCopyArea(pgx->display, pgx->pixmap, pgx->pixmap, pgx->expose_gc, blc_orig.x, trc_orig.y, trc_orig.x - blc_orig.x + 1, blc_orig.y - trc_orig.y + 1, blc_dest.x, trc_dest.y); /* * Clear the vacated area to the left or right of the copied area. */ if(dx > 0) { XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, blc.x, trc.y, (unsigned) dx, (unsigned) (blc.y - trc.y + 1)); } else if(dx < 0) { XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, trc_dest.x, trc.y, (unsigned) (-dx), (unsigned) (blc.y - trc.y + 1)); }; /* * Clear the vacated area above or below the copied area. */ if(dy > 0) { XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, blc.x, trc.y, (unsigned) (trc.x - blc.x + 1), (unsigned) dy); } else if(dy < 0) { XFillRectangle(pgx->display, pgx->pixmap, pgx->expose_gc, blc.x, blc_dest.y, (unsigned) (trc.x - blc.x + 1), (unsigned) (-dy)); }; }; /* * Record the extent of the modified part of the pixmap. */ pgx_mark_modified(pgx, blc.x, blc.y, 1); pgx_mark_modified(pgx, trc.x, trc.y, 1); }; return; } /*....................................................................... * Return the nearest integer to a given floating point number. * * Input: * f float The floating point number to be rounded. * Output: * return int The nearest integer to f. */ #ifdef __STDC__ static int pgx_nint(float f) #else static int pgx_nint(f) float f; #endif { return (int) (f >= 0.0 ? (f + 0.5) : (f - 0.5)); } /*....................................................................... * Find the parent window of a PGPLOT window. Note that we can't cache * this because reparenting window managers change the parent of * top-level windows. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return Window The parent window, or None on error. */ #ifdef __STDC__ Window pgx_parent_window(PgxWin *pgx) #else Window pgx_parent_window(pgx) PgxWin *pgx; #endif { Window root; Window parent; Window *children; unsigned int nchildren; if(!XQueryTree(pgx->display, pgx->window, &root, &parent, &children, &nchildren)) { fprintf(stderr, "pgx_parent_window: XQueryTree failed.\n"); pgx->bad_device = 1; return None; }; /* * Discard the unwanted list of children. */ XFree(children); return parent; } /*....................................................................... * Replace an existing set of readonly colors with new color representations. * * Input: * pgx PgxWin * The PGPLOT window context. * ncol int The number of colors to redefine. * Input/Output: * colors XColor * On input pass the array of ncol color * representations to allocate. On output this * will contain the newly allocated colors. * pixels unsigned long * The array of pixels corresponding to colors. * On calls when pgx->color->initialized is true * this should contain the pixels that are to be * replaced. On output it will contain the * allocated pixels. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int pgx_readonly_colors(PgxWin *pgx, int ncol, XColor *colors, unsigned long *pixels) #else static int pgx_readonly_colors(pgx, ncol, colors, pixels) PgxWin *pgx; int ncol; XColor *colors; unsigned long *pixels; #endif { int ngot=0; /* The number of colors acquired */ int i; /* * Get aliases to objects in pgx. */ Colormap cmap = pgx->color->cmap; Display *display = pgx->display; /* * No colors required? */ if(ncol < 1) return 0; /* * First discard all but the first of the colors that we are replacing. * The first will be used as a fallback if the first pgx->color->nwork * entries of the colormap contain no shared colors. */ if(pgx->color->initialized) XFreeColors(display, cmap, pixels+1, ncol-1, (long)0); /* * First ask for precise versions of the requested colors. If the * colormap is readonly, the X server will actually return the * nearest approximation. If the colormap is read/write XAllocColor * is documented to fail up if it can't find exactly the color that * one asks for (within the color resolution of the hardware)! * Mark those that can't be allocated by setting their flags to 0. */ for(i=0; iflags = 0; }; /* * If we failed to allocate precise versions of any of the colors, * try to allocate approximate versions of the colors. Note that * the X server is supposed to do this for us if the colormap is * readonly, but not if it is read/write. */ if(ngot < ncol) { XColor *last=NULL; /* The last color looked at while allocating colors */ int napprox=0; /* The number of approximate colors to choose from */ /* * Get the work array and its size. */ XColor *work = pgx->color->work; int nwork = pgx->color->nwork; /* * Ask the server for the first nwork colors in its colormap. */ for(i=0; ired != last->red || c->green != last->green || c->blue != last->blue)) { if(XAllocColor(display, cmap, c)) { if(i != napprox) work[napprox] = *c; napprox++; }; last = c; }; }; /* * Fill in the outstanding PGPLOT colors from those remaining in the work * array. Note that we must also re-allocate each of the chosen colors * so that it can be free'd as many times as it appears in our color table. */ for(i=0; i < ncol; i++) { XColor *c = colors + i; if(!c->flags) { if(pgx_nearest_color(work, napprox, c) || !XAllocColor(display, cmap, c)) break; else ngot++; }; }; /* * Release the work array of colors (note that the colors that were * chosen above were duplicately allocated, and X uses a reference * counting scheme for colormap entries, so this won't invalidate them). */ for(i=0; ipixel, 1, 0); }; }; /* * Did we fail to get all of the required colors? */ if(ngot < ncol) { /* * If we were (re-)allocating the whole colortable, discard all colors * allocated above the first that we failed to get and reduce ncol to * account for this. */ if(pixels==pgx->color->pixel && ncol >= pgx->color->npixel) { for(ngot=0; ngotcolor->npixel = ngot; pgx->color->ncol = ngot; /* * If we were replacing entries, then the size of the color table has already * been fixed, so we need to fill in the missing colors. Since we may not have * managed to allocate any colors, find out the color representation of the * first of the colors that we were replacing and reallocate for each of * the missing slots. Note that we were careful not to free this color * above, so it is supposedly guaranteed to still be allocatable as a * shared color. */ } else { /* * Get the color representation of the fallback color. */ XColor fallback; /* The color being used as a fallback */ fallback.pixel = pixels[0]; XQueryColor(display, cmap, &fallback); /* * Re-allocate the fallback entry for each missing color. */ for(i=0; iflags) { (void) XAllocColor(display, cmap, &fallback); *c = fallback; }; }; /* * We now have the requested number of colors, albeit with * unexpected colors. */ ngot = ncol; }; }; /* * Release the unfree'd first entry of the replaced colors. */ if(pgx->color->initialized) XFreeColors(display, cmap, pixels, 1, 0); /* * Record the new pixel indexes. */ for(i=0; ired < cb->red) return -1; else if(ca->red > cb->red) return 1; /* * The red components are the same, so compare the green components. */ if(ca->green < cb->green) return -1; else if(ca->green > cb->green) return 1; /* * Both the red components and the green components are the same, * so compare the blue components. */ if(ca->blue < cb->blue) return -1; else if(ca->blue > cb->blue) return 1; /* * The colors are identical. */ return 0; } /*....................................................................... * Find the nearest color in colors[] and assign it to *c. * * Input: * colors XColor * An array of ncol colors from which to choose. * Those whose flags are 0 are used. * ncol int The number of entries in colors[]. * Input/Output: * c XColor * On input this should contain the desired color. * On output it will contain the nearest unused color * found in colors[]. * Output: * return int 0 - OK. * 1 - There are no colors left. */ #ifdef __STDC__ static int pgx_nearest_color(XColor *colors, int ncol, XColor *c) #else static int pgx_nearest_color(colors, ncol, c) XColor *colors; int ncol; XColor *c; #endif { XColor *best=NULL; /* The nearest color found so far */ float residual=0; /* The square color residual of best compared to c */ int first = 1; /* True until residual has been initialized */ int i; /* * Find the unused entry in colors[] that is nearest to the requested color. */ for(i=0; ired - xc->red; float dg = c->green - xc->green; float db = c->blue - xc->blue; float r = dr * dr + dg * dg + db * db; if(r < residual || first) { first = 0; residual = r; best = xc; }; }; /* * Not found? */ if(!best) return 1; /* * Copy the color to the return container. */ *c = *best; return 0; } e parent window of a PGPLOT window. Note that we can't cache * this because reparenting window managers change the parent of * top-level windows. * * Input: * pgx PgxWin * The PGPLOT window context. * Output: * return Window The parent window, or None on error. */ #ipgplot/drivers/pgxwin.h010064400040640000322000000230570653012730100157010ustar00tjpcitmbr00000400000017#ifndef pgxwin_h #define pgxwin_h /* * The following macro must enclose all function prototype arguments. * This allows pre-ANSI compilers to compile this code, by discarding * the prototype arguments if __STDC__ is not set. */ #ifdef __STDC__ #define ARGS(args) args #else #define ARGS(args) () #endif typedef struct PgxWin PgxWin; /* * Declare a type for the function that the pgxwin library calls * whenever it wants to resize the PGPLOT window. * A function of this type must be assigned to the resize_window_fn * member of the PgxWin structure as follows: * If resizing is unrestricted, assign pgx_resize_window. * If resizing is to be disallowed, assign NULL. * Otherwise supply your own resize function. */ typedef void (*PgxResizeWindowFn) ARGS((PgxWin *pgx, unsigned width, \ unsigned height)); /* * Declare a type for the function that the pgxwin library calls * whenever it wants to create a new backing pixmap. The new pixmap * must be assigned to pgx->pixmap, and pgx->geom must be updated * to reflect its new dimensions. * A default function of this type pgx_new_pixmap() is substituted if * PgxWin::new_pixmap_fn==NULL. This should be satisfactory for * most cases. */ typedef void (*PgxNewPixmapFn) ARGS((PgxWin *pgx, unsigned width, \ unsigned height)); /* * Declare a visual/colormap context descriptor. */ typedef struct { XVisualInfo *vi; /* The visual info descriptor for the colormap */ Colormap cmap; /* Colormap ID */ int private; /* True if the colormap had to be newly allocated */ int ncol; /* The number of colors available. ci = [0...ncol-1] */ int monochrome; /* True we have to use a monochrome screen */ unsigned long *pixel; /* 'ncol' colormap pixel indexes. */ int npixel; /* The number of colorcells actually allocated */ XColor *xcolor; /* 'ncol' colormap color representations */ int initialized; /* True after pgx_init_colors() */ int default_class; /* The class of the default visual of the screen */ int readonly; /* True if the allocated color-cells are readonly */ int nwork; /* The number of entries in work[] */ XColor *work; /* Work array for shared color allocations */ } PgxColor; /* * Declare a scroll/pan context descriptor. * The x and y coordinates are the position of the top left corner * of the window within the pixmap. */ typedef struct { unsigned x; unsigned y; } PgxScroll; /* * Declare a container type to record the rectangular extent of the * window area that is available for drawing. Clipping is optional * and by default it is turned off, but if it is enabled (via * a call to pgx_update_clip()), then it should be kept up to date * by calling pgx_update_clip() whenever ConfigureNotify events * are received. */ typedef struct { int doclip; /* True if clipping is enabled */ int xmin, xmax; /* Min/max X-axis pixels excluding border */ int ymin, ymax; /* Min/max Y-axis pixels excluding border */ } PgxClip; typedef struct PgxState PgxState; /* * All X devices must fill a structure of the following type. */ struct PgxWin { void *context; /* The context descriptor of the window type */ Display *display; /* The display of the window */ int screen; /* The screen of the display */ Window window; /* The window id */ Pixmap pixmap; /* The backing pixmap (or None if not available) */ GC expose_gc; /* Expose-event handler graphical context */ int bad_device; /* Set to 1 by pgx_bad_device() after fatal error.*/ char *name; /* The name of the window */ int xmargin; /* The number of pixels to leave blank on */ /* either side of the plot area (default=0). */ int ymargin; /* The number of pixels to leave blank above */ /* and below the plot area (default=0). */ PgxColor *color; /* The visual/colormap context descriptor */ PgxScroll scroll; /* The pixmap scroll context descriptor */ PgxClip clip; /* The window clipping area */ PgxResizeWindowFn resize_fn; /* Function to call to resize window. */ PgxNewPixmapFn new_pixmap_fn; /* Function to call to allocate a new pixmap */ XErrorHandler old_handler;/* Used to preserve previous X error handler */ PgxState *state; /* This is NULL when not in use. It is created */ /* on pgbeg() via new_PgxState() and destroyed on */ /* pgend() via del_PgxState() */ }; int pgx_pre_opcode ARGS((PgxWin *pgx, int opcode)); int pgx_scroll ARGS((PgxWin *pgx, unsigned x, unsigned y)); int pgx_update_clip ARGS((PgxWin *pgx, int doclip, unsigned width, unsigned height, unsigned border)); int pgx_set_margin ARGS((PgxWin *pgx, int xmargin, int ymargin)); int pgx_expose ARGS((PgxWin *pgx, XEvent *event)); void pgx_start_error_watch ARGS((PgxWin *pgx)); int pgx_end_error_watch ARGS((PgxWin *pgx)); PgxWin *new_PgxWin ARGS((Display *display, int screen, void *context,char *name, PgxResizeWindowFn resize_fn, PgxNewPixmapFn pixmap_fn)); PgxWin *del_PgxWin ARGS((PgxWin *pgx)); PgxState *pgx_open ARGS((PgxWin *pgx)); PgxState *pgx_close ARGS((PgxWin *pgx)); int pgx_bad_device ARGS((PgxWin *pgx)); void pgx_draw_line ARGS((PgxWin *pgx, float *rbuf)); void pgx_draw_dot ARGS((PgxWin *pgx, float *rbuf)); int pgx_flush ARGS((PgxWin *pgx)); int pgx_set_ci ARGS((PgxWin *pgx, int ci)); void pgx_poly_fill ARGS((PgxWin *pgx, float *rbuf)); void pgx_rect_fill ARGS((PgxWin *pgx, float *rbuf)); void pgx_set_lw ARGS((PgxWin *pgx, float lw)); int pgx_pix_line ARGS((PgxWin *pgx, float *rbuf, int *nbuf)); void pgx_set_world ARGS((PgxWin *pgx, float *rbuf)); int pgx_set_rgb ARGS((PgxWin *pgx, int ci, float red, float green, float blue)); void pgx_get_rgb ARGS((PgxWin *pgx, float *rbuf, int *nbuf)); void pgx_scroll_rect ARGS((PgxWin *pgx, float *rbuf)); int pgx_clear_window ARGS((PgxWin *pgx)); void pgx_get_resolution ARGS((PgxWin *pgx, float *xpix_per_inch, \ float *ypix_per_inch)); void pgx_def_size ARGS((PgxWin *pgx, unsigned d_width, unsigned d_height, \ float *rbuf, int *nbuf)); void pgx_new_pixmap ARGS((PgxWin *pgx, unsigned width, unsigned height)); void pgx_begin_picture ARGS((PgxWin *pgx, float *rbuf)); int pgx_set_background ARGS((PgxWin *pgx, XColor *xc)); int pgx_set_foreground ARGS((PgxWin *pgx, XColor *xc)); unsigned pgx_pixmap_width ARGS((PgxWin *pgx)); unsigned pgx_pixmap_height ARGS((PgxWin *pgx)); /* Convert from X window coordinates to PGPLOT device coordinates */ int pgx_win2dev ARGS((PgxWin *pgx, int x, int y, float *rbuf)); /* Convert from PGPLOT device coordinates to PGPLOT world coordinates */ int pgx_dev2world ARGS((PgxWin *pgx, float *rbuf)); /* Convert from PGPLOT world coordinates to PGPLOT device coordinates */ int pgx_world2dev ARGS((PgxWin *pgx, float *rbuf)); /* Convert from PGPLOT device coordinates to X window coordinates */ int pgx_dev2win ARGS((PgxWin *pgx, float *rbuf, int *x, int *y)); /* Return the current parent of a given PGPLOT window */ Window pgx_parent_window ARGS((PgxWin *pgx)); /* * Alternate visual/colormap acquisition functions. */ /* Search for a suitable visual as directed by the 'class_name' string */ PgxColor *pgx_new_visual ARGS((PgxWin *pgx, char *class_name, int min_col, \ int max_col, int share)); /* Don't allocate any colors. Instead just use the black and white pixels * of the screen to implement a monochrome PGPLOT window. */ PgxColor *pgx_bw_visual ARGS((PgxWin *pgx)); /* Allocate colors from the default (root window) colormap */ PgxColor *pgx_default_visual ARGS((PgxWin *pgx, int min_col, int max_col, \ int share)); /* Allocate colors from a specified existing visual/colormap */ PgxColor *pgx_adopt_visual ARGS((PgxWin *pgx, VisualID vid, Colormap cmap, \ int min_col, int max_col, int share)); /* Allocate colors from the visual/colormap of a specified other window */ PgxColor *pgx_window_visual ARGS((PgxWin *pgx, Window w, int min_col, \ int max_col, int share)); /* Delete pgx->color */ PgxColor *pgx_del_visual ARGS((PgxWin *pgx)); /* Enumerate the types of cursor augmentation supported by pgx_set_cursor() */ #define PGX_NORM_CURSOR 0 /* Un-augmented X cursor */ #define PGX_LINE_CURSOR 1 /* Line cursor between beg and end */ #define PGX_RECT_CURSOR 2 /* Rectangular cursor between beg and end */ #define PGX_YRNG_CURSOR 3 /* Two horizontal lines, at beg.x and end.x */ #define PGX_XRNG_CURSOR 4 /* Two vertical lines, at beg.y and end.y */ #define PGX_VLINE_CURSOR 5 /* Vertical line cursor at x=beg.x */ #define PGX_HLINE_CURSOR 6 /* Horizontal line cursor at y=beg.y */ #define PGX_CROSS_CURSOR 7 /* Cross-hair cursor */ int pgx_set_cursor ARGS((PgxWin *pgx, int ci, int type, int warp, \ float *rbeg, float *rend)); int pgx_locate_cursor ARGS((PgxWin *pgx)); int pgx_refresh_cursor ARGS((PgxWin *pgx)); int pgx_draw_cursor ARGS((PgxWin *pgx)); int pgx_erase_cursor ARGS((PgxWin *pgx)); int pgx_cursor_event ARGS((PgxWin *pgx, XEvent *event, float *rbuf, char *key)); /* Enumerate the operations performed by pgx_select_events() */ #define PGX_SET_EVENTS 0 /* Replace the existing event mask */ #define PGX_ADD_EVENTS 1 /* Add events to the existing event mask */ #define PGX_REM_EVENTS 2 /* Remove events from the existing event mask */ unsigned long pgx_select_events ARGS((PgxWin *pgx, int oper, long events)); int pgx_read_cursor ARGS((PgxWin *pgx, float *rbuf, char *chr, int *nbuf, int *lchr)); int pgx_same_string ARGS((char *s1, char *s2)); #endif if the allocated color-cells are readonly */ int nwork; /* The number of entries in work[] */ XColor *work; /* Work array for shared color allocations */ } PgxColor; /* * Declare a scroll/pan context descriptor. * The x and y coordinates are the position of the top left corner * of the window within the pixmap. */ typedef struct { unsigned x; unsigned y; } PgxScroll; /* * Declare a container type to record the rectangular extepgplot/drivers/xmdriv.c010064400040640000322000000042600612564722300156760ustar00tjpcitmbr00000400000017#include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow xmdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call xmdriv() or xmdriv_(). */ #ifdef PG_PPU #define XMDRIV xmdriv_ #else #define XMDRIV xmdriv #endif /*....................................................................... * This is a stub version of the Motif PGPLOT widget device driver to * be included in the main PGPLOT library. The real driver resides in a * dedicated library, which when cited before libpgplot on the link line, * overrides this stub. The rational behind this is that if the real * driver were included in the PGPLOT library all applications that are * currently linked with PGPLOT would have to be changed to link with the * Motif library. */ #ifdef VMS void xmdriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void XMDRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif int i; /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: for(i=0; i < len; i++) chr[i] = ' '; *lchr = 0; break; default: fprintf(stderr, "/XMOTIF: Unexpected opcode=%d in stub driver.\n", *ifunc); *nbuf = -1; break; }; return; } pgplot/drivers/vtdriv-vms.f010064400040640000322000000737060621065716400165240ustar00tjpcitmbr00000400000017* Date: Tue, 27 Aug 1996 13:28:34 -0400 * From: Jerry Johnson 123 ROB/MRL/PSU C*VTDRIV -- PGPLOT Regis (VT125) driver C+ SUBROUTINE VTDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Regis devices. C C Version 1.1 - 1987 Aug 17 - add cursor (TJP). C Version 1.2 - 1988 Jan 11 - use SMG$ routines for cursor control. C Version 1.3 - 1988 Mar 23 - add rectangle fill. C Version 1.4 - 1988 Oct 27 - correct cursor bug. C Version 1.5 - 1992 Sep 04 - whq - add support for 16 color DEC VT340 C C Supported devices: Digital Equipment Corporation VT125, VT240, or C VT241 terminal; other REGIS devices may also work. (VT330, VT340 - whq) C C Device type code: /VT125. C C Default file name: TT:PGPLOT.VTPLOT. This usually means the C terminal you are logged in to (logical name TT), but the plot can be C sent to another terminal by giving the device name, eg, TTC0:/VT, or C it can be saved in a file by specifying a file name, eg, C CITSCR:[TJP]XPLOT/VT (in this case a disk name must be included as C part of the file name). C C Default view surface dimensions: Depends on monitor. C C Resolution: The default view surface is 768 (horizontal) x C 460 (vertical) pixels. On most Regis devices, the resolution is C degraded in the vertical direction giving only 230 distinguishable C raster lines. (There are actually 240 raster lines, but 10 are reserved C for a line of text.) C C Color capability: Color indices 0--3 are supported. By default, C color index 0 is black (the background color). Color indices 1--3 C are white, red, and green on color monitors, or white, dark grey, and C light grey on monochrome monitors. The color representation of all C the color indices can be changed, although only a finite number of C different colors can be obtained (see the manual for the terminal). c whq - Color indices 0--15 are supported if the device is a VT340. C C Input capability: The graphics cursor is a blinking C diamond-crosshair. The user positions the cursor using the arrow keys C and PF1--PF4 keys on his keyboard (SYS$COMMAND) [Note: NOT the key- C board of the terminal on which he is plotting, if that is different.] C The arrow keys move the cursor in the appropriate direction; the size C of the step for each keystroke is controlled by the PF1--PF4 keys: PF1 C -> 1 pixel, PF2 -> 4 pixels, PF3 -> 16 pixels, PF4 -> 64 pixels. [The C VT240 terminal has a built-in capability to position the cursor, but C PGPLOT does not use this as it is not available on the VT125.] The C user indicates that the cursor has been positioned by typing any C character other than an arrow or PF1-PF4 key [control characters, eg, C control-C, and other special characters should be avoided, as they C may be intercepted by the operating system]. C C File format: A REGIS plot file is formatted in records of 80 C characters or less, and has no carriage-control attributes. The C records are grouped into ``buffers,'' each of which begins with C Pp to put the terminal into graphics mode and ends with \ C to put it back into text mode. The terminal is in graphics mode only C while a buffer is being transmitted, so a user's program can write to C the terminal at any time (in text mode) without worrying if it might C be in graphics mode. Everything between the escape sequences is C REGIS: see the VT125 or VT240 manual for an explanation. PGPLOT C attempts to minimize the number of characters in the REGIS commands, C but REGIS is not a very efficient format. It does have the great C advantage, though, that it can easily be examined with an editor. C The file may also contain characters outside the Pp ... \ C delimiters, eg, escape sequences to erase the text screen and home C the cursor. C C The following escape sequences are used: C C [2J Erase entire screen (text) C [H Move cursor to home position C Pp Enter REGIS graphics mode C \ Leave REGIS graphics mode C C PGPLOT uses a very limited subset of the REGIS commands supported C by the VT125 and VT240. The following list summarizes the REGIS C commands presently used. C C Initialization: the following standard commands are used to initialize C the device every time a new frame is started; most of these restore a C VT125 or VT240 to its default state, but the screen addressing mode is C nonstandard. C C ; resynchronize C W(R) replace mode writing C W(I3) color index 1 C W(F3) both bit planes C W(F15) all bit planes for VT340 (whq) C W(M1) unit multiplier C W(N0) negative off C W(P1) pattern 1 C W(P(M2)) pattern multiplier 2 C W(S0) shading off C S(E) erase screen C S(G1) select graphics plane [Rainbow REGIS] C S(A[0,479][767,0]) screen addressing, origin at bottom left C S(I0) background dark C S(S1) scale 1 C S(M0(L0)(AL0)) output map section 0 (black) C S(M1(L30)(AH120L50S100)) output map section 1 (red/dim grey) C S(M2(L59)(AH240L50S100)) output map section 2 (green/light grey) C S(M3(L100)(AL100)) output map section 3 (white) c c whq - output map sections for VT340 - colors per PGPLOT manual c S(M0(L0)(AL0)) output map section 0 (black) ! whq c S(M3(L100)(AL100)) output map section 3 (white) ! whq c S(M1(L27)(AH120L46S72)) output map section 1 (red) ! whq c S(M2(L52)(AH240L50S60)) output map section 2 (green) ! whq c S(M4(L6)(AH0L50S60)) output map section 4 (blue) ! whq c S(M5(L86)(AH300L50S60)) output map section 5 (cyan) ! whq c S(M6(L19)(AH60L50S60)) output map section 6 (magenta) ! whq c S(M7(L59)(AH180L50S60)) output map section 7 (yellow) ! whq c S(M8(L46)(AH150L50S60)) output map section 8 (red+yellow) ! whq c S(M9(L72)(AH210L50S60)) output map section 9 (green+yellow) ! whq c S(M10(L79)(AH270L50S60)) output map section 10 (green+cyan) ! whq c S(M11(L92)(AH330L50S60)) output map section 11 (blue+cyan) ! whq c S(M12(L12)(AH30L50S60)) output map section 12 (blue+magenta) ! whq c S(M13(L39)(AH90L50S60)) output map section 13 (red+magenta) ! whq c S(M14(L33)(AL33)) output map section 14 (dark gray) ! whq c S(M15(L66)(AL66)) output map section 15 (light gray) ! whq C C Drawing lines: the P and V commands are used with absolute C coordinates, relative coordinates, and pixel vectors. The (B) C S), (E), and (W) modifiers are not used. Coordinates C which do not change are omitted. C C P[x,y] move to position, eg P[499,0] C V[x,y] draw vector to position, eg C V[][767][,479][0][,0] C C Line attributes: the line style and line color attributes are C specified with W commands, eg C C W(P2) line style 2 C W(I2) intensity (color index) 2 C C and S commands are used to change the output map. The PGPLOT color C indices 0, 1, 2, 3 correspond to output map sections 0, 3, 1, 2. C C Obtaining hardcopy: A hardcopy of the plot can be obtained C using a printer attached to the VT125/VT240 terminal (see the C instruction manual for the terminal). A plot stored in disk file C can be displayed by issuing a TYPE command (eg, TYPE PGPLOT.VTPLOT) C on a VT125 or VT240. C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='VT125') PARAMETER (DEFNAM='PGPLOT.VTPLOT') C CHARACTER*(*) VTINIT PARAMETER (VTINIT=';W(RI3F3M1N0P1P(M2)S0)S(E)'// 1 'S(G1A[0,479][767,0]I0S1)'// 2 'S(M0(L0)(AL0))'// 3 'S(M3(L100)(AL100))'// 4 'S(M1(L30)(AH120L50S100))'// 5 'S(M2(L59)(AH240L50S100))') character*(*) vt340init ! whq parameter (vt340init=';W(RI3F15M1N0P1P(M2)S0)S(E)'// ! whq + 'S(G1A[0,479][767,0]I0S1)'// ! whq + 'S(M0(L0)(AL0))'// ! whq + 'S(M3(L100)(AL100))'// ! whq + 'S(M1(L27)(AH120L46S72))'// ! whq + 'S(M2(L52)(AH240L50S60))'// ! whq + 'S(M4(L6)(AH0L50S60))'// ! whq + 'S(M5(L86)(AH300L50S60))'// ! whq + 'S(M6(L19)(AH60L50S60))'// ! whq + 'S(M7(L59)(AH180L50S60))'// ! whq + 'S(M8(L46)(AH150L50S60))'// ! whq + 'S(M9(L72)(AH210L50S60))'// ! whq + 'S(M10(L79)(AH270L50S60))'// ! whq + 'S(M11(L92)(AH330L50S60))'// ! whq + 'S(M12(L12)(AH30L50S60))'// ! whq + 'S(M13(L39)(AH90L50S60))'// ! whq + 'S(M14(L33)(AL33))'// ! whq + 'S(M15(L66)(AL66))') ! whq CHARACTER*(*) CURSOR, VTERAS PARAMETER (CURSOR=CHAR(27)//'[24;1f') PARAMETER (VTERAS=CHAR(27)//'[2J'//CHAR(27)//'[H') CHARACTER*10 MSG INTEGER IER, I0, J0, I1, J1, L, LASTI, LASTJ, UNIT INTEGER CI, LW, NPTS, L1, L2, BUFFER, BUFSIZ, BUFLEV INTEGER MONO, IR, IG, IB, IX, IY, ICH REAl CH, CL, CS PARAMETER (BUFSIZ=1024) INTEGER LIB$GET_VM, LIB$FREE_VM INTEGER SMG$CREATE_VIRTUAL_KEYBOARD INTEGER SMG$DELETE_VIRTUAL_KEYBOARD INTEGER SMG$SET_KEYPAD_MODE INTEGER KBID LOGICAL START, APPEND CHARACTER*64 INSTR CHARACTER*20 INSTR1,INSTR2 CHARACTER*2 PIX(0:22) DATA PIX /'V5','V4','V3',7*' ','V6',' ','V2',7*' ','V7', 1 'V0','V1'/ c INTEGER VTCODE(0:3) ! whq - old vtcode array c DATA VTCODE/ 0, 3, 1, 2 / ! whq - maintain 1st 4 in new array integer vtcode(0:15) ! whq - new vtcode array data vtcode /0,3,1,2,4,5,6,7,8,9,10,11,12,13,14,15/ ! whq logical lvt340 /.false./ ! whq - true if vt340 terminal logical grvt340 ! whq - function for vt340 testing C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, & 110,120,130,140,150,160,170,180,190,200, & 210,220,230,240), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in VT device driver: '//MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 767 RBUF(3) = 0 RBUF(4) = 479 RBUF(5) = 0 RBUF(6) = 3 if (lvt340) RBUF(6) = 15 ! whq - max index for VT340 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 100.0 RBUF(2) = 100.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area fill, C No thick lines, Rectangle fill) C 40 CHR = 'ICNNNRNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = 'TT:PGPLOT.VTPLOT' LCHR = 16 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0 RBUF(2) = 767 RBUF(3) = 0 RBUF(4) = 459 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE APPEND = RBUF(3).NE.0.0 C -- allocate buffer IER = LIB$GET_VM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRWARN('Failed to allocate plot buffer.') RBUF(2) = IER RETURN END IF CALL GRGLUN(UNIT) RBUF(1) = UNIT OPEN (UNIT=UNIT, FILE=CHR(:LCHR), CARRIAGECONTROL='NONE', 1 DEFAULTFILE=DEFNAM, DISPOSE='keep', STATUS='NEW', 2 FORM='FORMATTED', RECORDTYPE='VARIABLE', IOSTAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) CALL LIB$FREE_VM(BUFSIZ, BUFFER) return ! whq - return here if can't open endif ! whq - then endif c ELSE ! whq - so don't need else ... endif INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 c END IF ! whq lvt340 = grvt340(chr, lchr) ! whq - flag if device is a vt340 BUFLEV = 0 LASTI = -1 LASTJ = - 1 NPTS = 0 C -- create a virtual keyboard for cursor control IER = SMG$CREATE_VIRTUAL_KEYBOARD(KBID, 'SYS$COMMAND') IER = SMG$SET_KEYPAD_MODE(KBID, 1) RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE C -- reposition cursor WRITE (UNIT, '(A)') CURSOR CLOSE (UNIT, DISPOSE='KEEP') CALL GRFLUN(UNIT) IER = LIB$FREE_VM(BUFSIZ, BUFFER) IF (IER.NE.1) THEN CALL GRWARN('Error deallocating plot buffer.') CALL GRGMSG(IER) END IF C -- delete virtual keyboard IER = SMG$DELETE_VIRTUAL_KEYBOARD(KBID) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE C -- erase alpha screen and home cursor WRITE (UNIT, '(A)') VTERAS C -- erase and initialize graphics screen if (lvt340) then ! whq if (.not.append) call grvt02(vt340init,%val(buffer),buflev,unit) ! whq else ! whq IF (.NOT.APPEND) CALL GRVT02(VTINIT, %val(BUFFER), BUFLEV, UNIT) endif ! whq RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) IF (I0.NE.LASTI .OR. J0.NE.LASTJ) THEN CALL SYS$FAO('P[!SL,!SL]',L,INSTR,%VAL(I0),%VAL(J0)) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) CALL GRVT02('V[]', %val(BUFFER), BUFLEV, UNIT) END IF IF (I1.EQ.I0 .AND. J1.EQ.J0) THEN CONTINUE ELSE IF (ABS(I1-I0).LE.1 .AND. ABS(J1-J0).LE.1) THEN L = 10*(I1-I0+1) + (J1-J0+1) CALL GRVT02(PIX(L), %val(BUFFER), BUFLEV, UNIT) ELSE IF (I1.EQ.I0) THEN INSTR1 = 'V[' L1 = 2 ELSE IF (ABS(I1-I0).GE.100) THEN CALL SYS$FAO('V[!SL',L1,INSTR1,%VAL(I1)) ELSE IF (I1.GT.I0) THEN CALL SYS$FAO('V[+!SL',L1,INSTR1,%VAL(I1-I0)) ELSE CALL SYS$FAO('V[!SL',L1,INSTR1,%VAL(I1-I0)) END IF IF (J1.EQ.J0) THEN INSTR2 = ']' L2 = 1 ELSE IF (ABS(J1-J0).GE.100) THEN CALL SYS$FAO(',!SL]',L2,INSTR2,%VAL(J1)) ELSE IF (J1.GT.J0) THEN CALL SYS$FAO(',+!SL]',L2,INSTR2,%VAL(J1-J0)) ELSE CALL SYS$FAO(',!SL]',L2,INSTR2,%VAL(J1-J0)) END IF CALL GRVT02(INSTR1(1:L1)//INSTR2(1:L2), 1 %val(BUFFER), BUFLEV, UNIT) END IF LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) IF (I1.NE.LASTI .OR. J1.NE.LASTJ) THEN CALL SYS$FAO('P[!SL,!SL]V[]',L,INSTR,%VAL(I1),%VAL(J1)) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) END IF LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE C -- flush CALL GRVT03(%val(BUFFER), UNIT, BUFLEV) RETURN C C--- IFUNC=15, Select color index. ------------------------------------- C 150 CONTINUE CI = NINT(RBUF(1)) if (lvt340) then ! whq if (ci.gt.15 .or. ci.lt.0) ci = 1 ! whq else ! whq IF (CI.GT.3 .OR. CI.LT.0) CI = 1 endif ! whq CALL SYS$FAO('W(I!SL)',L,INSTR,%VAL(VTCODE(CI))) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) LASTI = -1 RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE C -- flush CALL GRVT03(%val(BUFFER), UNIT, BUFLEV) RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C RBUF(1) in/out : cursor x coordinate. C RBUF(2) in/out : cursor y coordinate. C CHR(1:1) output : keystroke. C 170 CONTINUE C -- flush buffer CALL GRVT03(%val(BUFFER), UNIT, BUFLEV) C -- IX = NINT(RBUF(1)) IY = NINT(RBUF(2)) CALL GRVT04(IX, IY, ICH, IER, UNIT, KBID) IF (IER.EQ.1) THEN RBUF(1) = IX RBUF(2) = IY CHR = CHAR(ICH) ELSE CHR = CHAR(0) END IF NBUF = 2 LCHR = 1 LASTI = -1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE C -- flush CALL GRVT03(%val(BUFFER), UNIT, BUFLEV) C -- erase alpha screen and home cursor WRITE (UNIT, '(A)') VTERAS RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called.) C 190 GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C (Not implemented: should not be called.) C 200 GOTO 900 C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE CI = RBUF(1) MONO = NINT(30.*RBUF(2) + 59.*RBUF(3) + 11.*RBUF(4)) CALL GRXHLS(RBUF(2),RBUF(3),RBUF(4),CH,CL,CS) IR = NINT(CH) ! hue IG = NINT(100.*CL) ! lightness IB = NINT(100.*CS) ! saturation CALL SYS$FAO('S(M!SL(L!SL)(AH!SLL!SLS!SL))',L,INSTR, 1 %VAL(VTCODE(CI)),%VAL(MONO),%VAL(IR),%VAL(IG),%VAL(IB)) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C (Not implemented: should not be called.) C 220 GOTO 900 C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE C -- flush CALL GRVT03(%val(BUFFER), UNIT, BUFLEV) C -- write string WRITE (UNIT, '(A)') CHR(:LCHR) LASTI = -1 RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) C -- move to top left and turn shading on CALL SYS$FAO('W(S1[,!SL])P[!SL,!SL]V[]',L,INSTR,%VAL(J0), 1 %VAL(I0),%VAL(J1)) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) C -- draw to top right and turn shading off CALL SYS$FAO('V[!SL,!SL]W(S0)',L,INSTR, 1 %VAL(I1),%VAL(J1)) CALL GRVT02(INSTR(1:L), %val(BUFFER), BUFLEV, UNIT) LASTI = -1 RETURN C----------------------------------------------------------------------- END C*GRVT02 -- PGPLOT Regis (VT125) driver, transfer data to buffer C+ SUBROUTINE GRVT02 (INSTR, BUFFER, HWM, UNIT) INTEGER HWM, UNIT CHARACTER*(*) INSTR BYTE BUFFER(*) C C Arguments: C INSTR (input) : text of instruction (bytes). C BUFFER (input) : output buffer. C HWM (in/out) : number of bytes used in BUFFER. C UNIT (input) : channel number for output (when buffer is full). C C Subroutines called: C GRVT03 C----------------------------------------------------------------------- INTEGER BUFSIZ PARAMETER (BUFSIZ=1024) INTEGER I, N C----------------------------------------------------------------------- N = LEN(INSTR) IF (HWM+N.GE.BUFSIZ) CALL GRVT03(BUFFER, UNIT, HWM) DO 10 I=1,N HWM = HWM + 1 BUFFER(HWM) = ICHAR(INSTR(I:I)) 10 CONTINUE C----------------------------------------------------------------------- END C*GRVT03 -- PGPLOT Regis (VT125) driver, copy buffer to device C+ SUBROUTINE GRVT03 (BUFFER, UNIT, N) BYTE BUFFER(*) INTEGER UNIT, N C C Arguments: C BUFFER (input) address of buffer to be output C UNIT (input) channel number for output C N (input) number of bytes to transfer C (output) set to zero C----------------------------------------------------------------------- INTEGER I BYTE PREFIX(3), SUFFIX(2) DATA PREFIX / 27, 'P', 'p' / DATA SUFFIX /27, '\' / C----------------------------------------------------------------------- IF (N.GE.1) 1 WRITE (UNIT, '(130A1)') PREFIX, (BUFFER(I),I=1,N), SUFFIX N = 0 C----------------------------------------------------------------------- END C*GRVT04 -- PGPLOT Regis (VT125) driver, cursor routine C+ SUBROUTINE GRVT04 (IX, IY, IC, IER, UNIT, KBID) INTEGER IX, IY, IC, IER, UNIT, KBID C C Arguments: C IX, IY (in/out) : initial/final coordinates of cursor (device C coordinates). C IC (output) : character code. C IER (output) : error status (1 => OK). C UNIT (input) : channel for output to device. C KBID (input) : SMG keyboard identifier for control. C C The cursor is moved by using the arrow keys on the C terminal; the cursor "speed" (step size) is controlled by the C PF1 (smallest step) to PF4 (largest step) keys. The numeric keys C on the keypad can be used in place of the arrow keys, with the C addition of diagonal motion: C ^ C 7 8 9 C < 4 6 > C 1 2 3 C v C C The user indicates that the cursor has been positioned by C typing any character on his keyboard (SYS$COMMAND), with the C following exceptions: control characters (^C, ^O, ^Q, ^R, ^S, C ^T, ^U, ^X, ^Y, DEL) are intercepted by the operating system C and cannot be used; NUL, ESC (^[) and escape sequences (e.g., C arrow keys) are ignored by GRCURS. C----------------------------------------------------------------------- INTEGER IXG,IYG INTEGER SMG$READ_KEYSTROKE INTEGER STEP DATA STEP/4/ ! initial step size C----------------------------------------------------------------------- 10 IXG = IX IYG = IY C -- position graphics cursor WRITE (UNIT,111) CHAR(27),IX,IY 111 FORMAT(A,'PpP[', I4 ,',', I4 ,']') IER = SMG$READ_KEYSTROKE(KBID, IC) IF (IER.NE.1) RETURN IF (IC.EQ.274 .OR. IC.EQ.268) THEN C key UP or KP8 IY = MIN(479,IY+STEP) ELSE IF (IC.EQ.275 .OR. IC.EQ.262) THEN C key DOWN or KP2 IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.276 .OR. IC.EQ.264) THEN C key LEFT or KP4 IX = MAX(0,IX-STEP) ELSE IF (IC.EQ.277 .OR. IC.EQ.266) THEN C key RIGHT or KP6 IX = MIN(767,IX+STEP) ELSE IF (IC.EQ.267) THEN C key KP7 IX = MAX(0,IX-STEP) IY = MIN(479,IY+STEP) ELSE IF (IC.EQ.269) THEN C key KP9 IX = MIN(767,IX+STEP) IY = MIN(479,IY+STEP) ELSE IF (IC.EQ.263) THEN C key KP3 IX = MIN(767,IX+STEP) IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.261) THEN C key KP1 IX = MAX(0,IX-STEP) IY = MAX(0,IY-STEP) ELSE IF (IC.EQ.256) THEN C key PF1 STEP = 1 ELSE IF (IC.EQ.257) THEN C key PF2 STEP = 4 ELSE IF (IC.EQ.258) THEN C key PF3 STEP = 16 ELSE IF (IC.EQ.259) THEN C key PF4 STEP = 64 END IF C -- back to text mode WRITE (UNIT,112) CHAR(27) 112 FORMAT(A,'\') IF (IC.LE.0 .OR. IC.GT.255) GOTO 10 C----------------------------------------------------------------------- END C----------------------------------------------------------------------- C*GRVT340 -- PGPLOT Regis (VT125) driver, check for DEC VT340 routine C+ logical function grvt340(chr, lchr) character*(*) chr integer lchr C C If device is a terminal, sends primary and secondary da (device attributes) C to determine if it is a DEC VT340. As implemented, the terminal must be C set for 7 bit controls in order to be recognized as a VT340. C C Arguments: C chr : (input) the name of the device (character) C lchr : (input) the length of the device name (integer) C C Returns: C GRVT340 (logical) .TRUE. if device is a DEC VT340 terminal, .FALSE. if not. C C-- C 4-Sep-1992 [whq] C----------------------------------------------------------------------- logical grchkt ! uses GRVMS grchkt logical testing, intime ! parse and timeout flags character*(*) primaryda, secondaryda ! da request strings character*(*) vt3xx, vt340 ! da response strings parameter (primaryda=char(27)//'[c') ! primary da request parameter (secondaryda=char(27)//'[>c') ! secondary da request parameter (vt3xx=char(27)//'[?63') ! 5 bytes of vt3xx response parameter (vt340=char(27)//'[>19') ! 5 bytes of vt340 response integer i, ic ! counter and response char character image*40 ! request buffer integer imi(1) ! request buffer equivalence (image, imi) ! pass buffer as integer array grvt340 = .false. ! assume not vt340 initially if (grchkt(chr(1:lchr))) then ! if device is a terminal c write(*, '(a,/)')' device is a terminal' ! debug call grvtttopen ! open it for i/o image = primaryda ! make primary da request call grvtttout(imi, 3) testing = .true. ! test for vt3xx response i = 1 image = vt3xx do while (testing) call grvtttin(ic, intime) ! get response if (intime .and. (char(ic) .eq. image(i:i))) then if (i .eq. 5) then ! got vt3xx response do while (intime.and.(ic.ne.ichar('c'))) call grvtttin(ic, intime) ! eat until get 'c' enddo c write(*, '(a,/)')' got vt3xx response' ! debug image = secondaryda ! make secondary da request call grvtttout(imi, 4) i = 1 image = vt340 ! test for vt340 response do while (testing) call grvtttin(ic, intime) ! get response if (intime .and. (char(ic) .eq. image(i:i))) then if (i .eq. 5) then ! got vt340 response do while (intime.and.(ic.ne.ichar('c'))) call grvtttin(ic, intime) ! eat until get 'c' enddo c write(*, '(a,/)')' got vt340 response' ! debug grvt340 = .true. ! flag success! testing = .false. else i = i + 1 endif else if (i .ge. 3) then ! got a DEC escape response do while (intime.and.(ic.ne.ichar('c'))) call grvtttin(ic,intime) ! eat until get 'c' enddo endif testing = .false. endif enddo else i = i + 1 ! matching OK, test next endif else if (i .ge. 3) then ! got a DEC escape response do while (intime .and. (ic .ne. ichar('c'))) call grvtttin(ic,intime) ! eat until get 'c' enddo else if (intime) then ! got some kind of response i = 1 ! eat chars until time out or do while (intime.and.(i.le.40)) ! have eaten arbitrary 40 call grvtttin(ic,intime) i = i + 1 enddo endif testing = .false. endif enddo call grvtttclose ! close the terminal endif return end C----------------------------------------------------------------------- C*GRVTTTOPEN -- PGPLOT Regis (VT125) driver, TT i/o routine for GRVT340 C+ subroutine grvtttopen C C open TT for i/o C C-- C 4-Sep-1992 [whq] C----------------------------------------------------------------------- include '($iodef)' include '($syssrvnam)' include '($ssdef)' integer ttchan, istat ! terminal channel and error status integer idata ! character data integer terminators(2) /0,0/ ! i/o terminators - none integer*2 status(4) ! i/o status integer ians, irequest, inum logical lttintime istat = sys$assign('TT',ttchan,,) call sys$setef(%val(1)) return C----------------------------------------------------------------------- C*GRVTTTIN -- PGPLOT Regis (VT125) driver, TT i/o routine for GRVT340 C+ entry grvtttin(ians, lttintime) C C get character from TT - uses 8 s time out C C Arguments: C ians : receives character C lttintime : receives .true. unless time out occurs, then .false. C-- C 4-Sep-1992 [whq] C----------------------------------------------------------------------- lttintime = .true. istat = sys$qiow(,%val(ttchan), + %val(IO$_TTYREADALL.or.IO$M_NOECHO.or.IO$M_TIMED), + status,,,idata,%val(1),%val(8),terminators,,) if ((status(1) .eq. SS$_TIMEOUT) .or. (.not. istat)) + lttintime = .false. ians = idata return C----------------------------------------------------------------------- C*GRVTTTOUT -- PGPLOT Regis (VT125) driver, TT i/o routine for GRVT340 C+ entry grvtttout(irequest, inum) C C send the character buffer irequest, of length inum, to TT C C Arguments: C irequest : (input) the character buffer (integer array) C inum : (input) number of characters in the buffer C-- C 4-Sep-1992 [whq] C----------------------------------------------------------------------- call sys$waitfr(%val(1)) call sys$qio(%val(1),%val(ttchan), + %val(IO$_WRITEVBLK.or.IO$M_NOFORMAT), + ,,,irequest,%val(inum),,%val(0),,) call sys$waitfr(%val(1)) return C----------------------------------------------------------------------- C*GRVTTTCLOSE -- PGPLOT Regis (VT125) driver, TT i/o routine for GRVT340 C+ entry grvtttclose C C close the TT channel C C-- C 4-Sep-1992 [whq] C----------------------------------------------------------------------- istat = sys$dassgn(ttchan) return end ---------------------------------------------------- pgplot/drivers/xwdriv.c010064400040640000322000004072310721555045200157130ustar00tjpcitmbr00000400000017/*....................................................................... * PGPLOT driver for workstations running X Windows. * Version 1.0 - 1989 Nov 06 - A. L. Fey * Version 3.0 - 1994 Nov 06 - M. C. Shepherd (mcs@astro.caltech.edu). * Re-write. Visible changes include: * 1. Corrected expose-event handling. * 2. The driver now runs a window server, * so that if requested, windows * persist for re-use by later programs. * 3. Support for gray-scale and truecolor visuals. * 4. Support for private color maps. * 5. Support for window-resizing by the user. * 6. New X-resources: pgxwin.geometry, * pgxwin.iconize, pgxwin.minColors, * pgxwin.maxColors, pgxwin.visual, * pgxwin.acceptQuit, pgxwin.crosshair. * 7. "rubber-band" cursor options for use with * pgband(). * 8. Corrected selective event handling. * 9. Fixed input focus code so that iconizing * doesn't kill the program. * 10. Arranged for the window manager to ignore * the delete-window option unless the * pgxwin.acceptQuit resource is assigned a * truth value. * 11. Added XErrorEvent handling to prevent program * crashes. * 12. Cursor warps are defered until the cursor * enters the /xw window, and can be turned * off entirely with the appropriate argument * to PGBAND(). * 13. Colormap updates are now buffered. * 14. Support for multiple open devices. * 15. The cursor can now be moved with the * keyboard arrow keys. * * Scope: This driver should work with all unix workstations running * X Windows (Version 11). It also works on VMS and OpenVMS * workstations running X. * Color: Visual color maps of types, PsuedoColor, StaticColor, GrayScale * and StaticGray are supported. Where insufficient colors are * available in the default colormap, a private colormap is * requested. If this fails, the device is treated as * monochrome. * Cursor: The cursor is controlled by a mouse or equivalent. Buttons * 1 2 3 are mapped to characters A D X. The cursor can also * be moved horizontally and vertically with the arrow keys. * Each press of an arrow key moves the cursor one pixel. This * can be increased to 10 pixels by pressing the shift key. * Size: The initial size and position of the window number #, * is determined with the following heirachy of specifications, * missing details at each level are supplied by those below. * * 1. X-resource: pgxwin.win#.geometry: WIDTHxHEIGHT+X+Y * 2. X-resource: pgxwin.Win.geometry: WIDTHxHEIGHT+X+Y * 3. Environment variable: PGPLOT_XW_WIDTH [fractional display width] * 4. #define's: XW_DEF_WIDTH, XW_DEF_HEIGHT, XW_DEF_ASPECT * * There are too many other configuration options to document here, but * complete documentation of the driver is available over the WEB at URL: * * http://astro.caltech.edu/~tjp/xwdriv.html * */ /* * Certain symbols in fcntl.h may not get defined * unless the _POSIX_SOURCE feature-test macro is set. */ #ifndef _POSIX_SOURCE #define _POSIX_SOURCE #endif /* * Allow xwdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call xwdriv() or xwdriv_(). */ #ifdef PG_PPU #define XWDRIV xwdriv_ #else #define XWDRIV xwdriv #endif #include #include #include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include /* sleep() is prototyped here */ #include /* access() is prototyped here */ #include #include #include #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; static int vms_define_command(char *file, char *command); static int vms_spawn_nowait(char *command); #endif #ifndef VMS #include #include #endif /* X-Window include files */ #include #include #include #include #include /* * Record the client/server protocol revision implemented herein. */ #define PGXWIN_REVISION 0 /* * Allow the pgplot /xw server name to be changed by compile * time pre-definition of PGXWIN_SERVER. If pgxwin_server is modified in * such a way as to become incompatible with an earlier version of xwdriv.c, * its name should be changed by postfixing a small increasing integer * to the name of the executable. New and old pgplot programs can then * coexist as long as both versions of the server are * retained. In order not to clutter up system directories, don't change * this name unless absolutely necessary. This is also the name given to * the server selection atom, so be sure that it remains valid for this * purpose. */ #ifndef PGXWIN_SERVER #define PGXWIN_SERVER "pgxwin_server" #endif #define NCOLORS 16 /* Number of pre-defined PGPLOT colors */ #define XW_IMAGE_LEN 1280 /* Length of the line-of-pixels buffer */ #define COLORMULT 65535 /* Normalized color intensity multiplier */ #define XW_IDENT "PGPLOT /xw" /* Name to prefix messages to user */ #define XW_DEF_ASPECT (8.5/11.0) /* Default aspect (height/width) of window */ #define XW_DEF_WIDTH 867 /* Default width (pixels) */ #define XW_DEF_HEIGHT ((int) XW_DEF_WIDTH * XW_DEF_ASPECT) /* Default height (pixels) */ #define XW_SERVER_TIMEOUT 10 /* Max time to allow for server startup */ /* * Define equivalence values for the XParseGeometry bitmask bits, using * values agreed upon by xwdriv.c and pgxwin_server.c, for use in * communicating geometries between client and server. */ #define XW_WidthValue 1 #define XW_HeightValue 2 #define XW_XValue 4 #define XW_YValue 8 #define XW_XNegative 16 #define XW_YNegative 32 /* * Enumerate the supported window close-down modes. */ #define XW_DELETE 1 #define XW_PERSIST 2 #define XW_ICONIZE 3 /* * Enumerate property-data formats, named after the internal types that * are used to communicate them with XChangeProperty() and * XGetWindowProperty(). */ #define XW_CHAR_PROP 8 #define XW_SHORT_PROP 16 #define XW_LONG_PROP 32 /* * Set the degree to which holding down the shift-key speeds up cursor * motion when an arrow key is held down. */ #define ARROW_KEY_VELOCITY 10 /* * The following macro must enclose all function prototype arguments. * This allows pre-ANSI compilers to compile this code, by discarding * the prototype arguments if __STDC__ is not set. */ #ifdef __STDC__ #define ARGS(args) args #else #define ARGS(args) () #endif /* A container used to record the geometry of the X-window */ typedef struct { Atom geom_atom; /* Client/server geometry transaction atom */ int x,y; /* Locus of top left corner of window (pixels) */ unsigned int width; /* Width of window (pixels) */ unsigned int height; /* Height of window (pixels) */ int xpix_per_inch; /* Number of pixels per inch along X */ int ypix_per_inch; /* Number of pixels per inch along Y */ int xmargin; /* X-axis 1/4" margin in pixels */ int ymargin; /* Y-axis 1/4" margin in pixels */ int xmin,xmax; /* Min/max X-axis pixels excluding 1/4" margins */ int ymin,ymax; /* Min/max X-axis pixels excluding 1/4" margins */ } XWgeom; /* * Declare a colormap descriptor. */ typedef struct { XVisualInfo *vi; /* The visual info descriptor for the colormap */ Colormap cmap; /* Colormap ID */ int ncol; /* The number of colors available. ci = [0...ncol-1] */ int monochrome; /* True we have to use a monochrome screen */ unsigned long *pixel; /* 'ncol' colormap pixel indexes. */ XColor *xcolor; /* 'ncol' colormap color representations */ int initialized; /* True after the first call to xw_init_colors() */ int nbuff; /* The number of buffered color representation updates */ int sbuff; /* The index of the first buffered color representation */ } XWcolor; /* * Declare a polygon descriptor. */ typedef struct { XPoint *points; /* Temporary array of polygon vertexes */ int npoint; /* Number of points in polygon */ int ndone; /* The number of points received so far */ } XWpoly; /* * Declare a container used to record the extent of the rectangular * pixmap area that has been modified since the last xw_flush(). */ typedef struct { int modified; /* True if 'pixmap' has been modified since last update */ int xmin,xmax; /* X-axis extent of modified region (pixels) */ int ymin,ymax; /* Y-axis extent of modified region (pixels) */ } XWupdate; /* * Declare a container to encapsulate the buffers needed to * draw a line of pixels. */ typedef struct { XImage *xi; /* Line of pixels Xlib image object */ } XWimage; /* * Declare a container used to hold event state information. */ typedef struct { long mask; /* Current event mask */ int no_buttons; /* True after failure to acquire ButtonPressMask */ } XWevent; /* * Declare a function type, instances of which are to be called to flush * buffered opcodes, and return 0 if OK, or 1 on error. */ struct XWdev; typedef int (*Flush_Opcode_fn) ARGS((struct XWdev *xw)); /* * The following container is used to retain state information for /xw * connections. */ typedef struct XWdev { Display *display; /* Display descriptor */ Window parent; /* The ID of the parent window */ Window window; /* Window ID */ Window client; /* Client communication window */ Window server; /* Server communication window */ Atom server_atom; /* Server selection atom */ Atom client_data; /* Client data property atom */ int protocol; /* Client/server communication protocol to use */ int number; /* PGPLOT window number */ int screen; /* The screen in which the window is displayed */ int disposition; /* Close-down mode: XW_PERSIST, XW_ICONIZE, XW_DELETE */ int bad_device; /* Set to 1 by xw_bad_device() after fatal errors. */ int last_error; /* The last error code trapped by xw_error() */ Pixmap pixmap; /* Pixmap ID */ Cursor norm_cursor;/* ID of normal cursor */ Cursor live_cursor;/* ID of active cursor */ int crosshair; /* Show intersecting line cursor if true */ XWpoly poly; /* Polygon-fill accumulation descriptor */ XWcolor color; /* Colormap descriptor */ XWgeom geom; /* The size and position of the window */ XWupdate update; /* Descriptor of un-drawn area of pixmap */ XWevent event; /* Event state container */ XWimage image; /* Line of pixels container */ XGCValues gcv; /* Publicly visible contents of 'gc' */ GC gc; /* Graphical context descriptor */ int last_opcode; /* Index of last opcode */ Flush_Opcode_fn flush_opcode_fn; /* Function to flush a buffered opcode */ struct XWdev *next;/* Pointer to next /xw device in list */ } XWdev; /* Create an alias for the standard X error handling function type */ typedef int (*Xerrorfn) ARGS((Display *, XErrorEvent *)); /* Private method functions that operate on XWdev descriptors */ static XWdev *new_XWdev ARGS((char *display, int mode)); static XWdev *del_XWdev ARGS((XWdev *xw, int partial)); static int xw_bad_device ARGS((XWdev *xw)); static int xw_ok ARGS((XWdev *xw)); static int xw_set_rgb ARGS((XWdev *xw, int ci, float red, float green, float blue)); static int xw_get_visual ARGS((XWdev *xw)); static int xw_init_colors ARGS((XWdev *xw)); static Window xw_get_window ARGS((XWdev *xw)); static Pixmap xw_get_pixmap ARGS((XWdev *xw)); static int xw_get_cursors ARGS((XWdev *xw)); static int xw_get_image ARGS((XWdev *xw, int npix)); static Window xw_get_server ARGS((XWdev *xw)); static int xw_query_server ARGS((XWdev *xw, XEvent *event)); static int xw_set_cursor ARGS((XWdev *xw, int norm)); static int xw_clear ARGS((XWdev *xw)); static int xw_set_ci ARGS((XWdev *xw, int ci)); static void xw_mark_modified ARGS((XWdev *xw, int x, int y, int diameter)); static int xw_flush ARGS((XWdev *xw)); static void xw_XPoint_to_xy ARGS((XWdev *xw, XPoint *xp, float *xy)); static void xw_xy_to_XPoint ARGS((XWdev *xw, float *xy, XPoint *xp)); static float xw_xcolor_to_rgb ARGS((unsigned short urgb)); static int xw_rgb_to_xcolor ARGS((float rgb)); static int xw_next_page ARGS((XWdev *xw, unsigned int width, unsigned int height)); static int xw_image_line ARGS((XWdev *xw, XPoint *start, float *cells, int ncell)); static int xw_read_cursor ARGS((XWdev *xw, int mode, int posn, XPoint *ref, XPoint *pos, char *key)); static int xw_shift_cursor ARGS((XWdev *xw, KeySym keysym, \ unsigned int modifiers)); static int xw_expose ARGS((XWdev *xw, XEvent *event)); static int xw_new_geom ARGS((XWdev *xw, int x, int y, unsigned int width, unsigned int height,int mask)); static int xw_error ARGS((Display *display, XErrorEvent *event)); static int xw_locate_cursor ARGS((XWdev *xw, XPoint *pos, int warp, XPoint *loc)); static int xw_next_event ARGS((XWdev *xw, XEvent *event)); static int xw_check_window_event ARGS((XWdev *xw, Window window, long event_mask, XEvent *event)); static unsigned long xw_get_data ARGS((XWdev *xw, char *data, int form, unsigned long n)); static XVisualInfo *xw_visual_info ARGS((Display *display, int screen, Visual *visual)); static void xw_limit_pcoords ARGS((XWdev *xw, XPoint *coord)); static void xw_scroll_rect ARGS((XWdev *xw, float *rbuf)); /* Container for rubber-band cursor resources and status */ typedef struct { int line_width; /* Rubber-band line width */ int mode; /* Cursor mode 1=line, 2=rectangle */ XPoint ref; /* Reference vertex of cursor */ XPoint end; /* End point of cursor */ } Band; static Band *xw_new_Band ARGS((XWdev *xw, int mode, XPoint *ref)); static int xw_draw_cursor ARGS((XWdev *xw, Band *bc, XPoint *end)); static int xw_erase_cursor ARGS((XWdev *xw, Band *bc)); static int xw_end_cursor ARGS((XWdev *xw, Band *bc, int status)); static Band *xw_del_Band ARGS((XWdev *xw, Band *bc)); static int xw_bound_cursor ARGS((XWdev *xw, XPoint *xp)); static int xw_cursor_line ARGS((XWdev *xw, int xa, int ya, int xb, int yb)); static int xw_add_events ARGS((XWdev *xw, long events)); static int xw_rem_events ARGS((XWdev *xw, long events)); /* Functions used to flush buffered opcodes */ static int xw_update_colors ARGS((XWdev *xw)); /* * Declare the head of the list of open XW device descriptors. * This has to have file scope to allow the X error handler to get at it. */ static XWdev *device_list = NULL; static XWdev *xw_insert_device ARGS((XWdev *xw)); static XWdev *xw_select_device ARGS((int number)); static XWdev *xw_remove_device ARGS((XWdev *xw)); static char *find_exe ARGS((char *path, char *program)); static int xw_nint ARGS((float f)); /*....................................................................... * This is the only external entry point to the /xw device driver. * It is called by PGPLOT to open, perform operations on, return * information about and close /xw windows. * * Input: * ifunc int * The PGPLOT operation code to be executed. * Input/output: * rbuf float * A general buffer for input/output of float values. * nbuf int * Where relevant this is used to return the number of * elements in rbuf[]. Also used on input to specify * number of pixels in the line-of-pixels primitive. * chr char * A general buffer for string I/O. * lchr int * Where relevant this is used to send and return the * number of significant characters in chr. * Input: * mode int * The value of *mode specifies the disposition of * the device: * 1 - /XWINDOW => non-persistent window. * 2 - /XSERVE => persistent window. * len int Added to the call line by the FORTRAN compiler. * This contains the declared size of chr[]. */ #ifdef VMS void xwdriv(ifunc, rbuf, nbuf, chrdsc, lchr, mode) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; int *mode; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void XWDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, len) int *ifunc, *nbuf, *lchr, *mode; int len; float rbuf[]; char *chr; { #endif static XWdev *xw = NULL; /* The descriptor of the currently selected device */ int i; /* * If there is a buffered opcode and the latest opcode is not the same * as the last opcode, call the given flush function for the * buffered opcode. */ if(xw && !xw->bad_device) { if(xw->last_opcode != *ifunc) { if(xw->flush_opcode_fn != (Flush_Opcode_fn) 0) { (*xw->flush_opcode_fn)(xw); xw->flush_opcode_fn = (Flush_Opcode_fn) 0; }; /* * Record the current opcode for next time. */ xw->last_opcode = *ifunc; }; }; /* Branch on opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { char *dev_name; switch(*mode) { /* Locate the name used to select the given mode */ case 1: default: dev_name = "XWINDOW (X window window@node:display.screen/xw)"; break; case 2: dev_name = "XSERVE (A /XWINDOW window that persists for re-use)"; break; }; strncpy(chr, dev_name, len); *lchr = strlen(dev_name); for(i = *lchr; i < len; i++) chr[i] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = -1.0; /* Report no effective max plot width */ rbuf[2] = 0.0; rbuf[3] = -1.0; /* Report no effective max plot height */ rbuf[4] = 0.0; rbuf[5] = (xw && !xw->bad_device) ? xw->color.ncol-1 : 1; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: if(xw_ok(xw)) { rbuf[0] = xw->geom.xpix_per_inch; rbuf[1] = xw->geom.ypix_per_inch; } else { rbuf[0] = 1.0; rbuf[1] = 1.0; }; rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'I'; /* Interactive device */ chr[1] = 'C'; /* Cursor is available */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines */ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ /* * Tell PGPLOT to prompt on PGEND only if the window goes away. */ chr[7] = xw && xw->disposition==XW_PERSIST ? 'N':'V'; chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10]= 'S'; /* Area-scroll available */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: chr[0] = '\0'; /* Default name is "" */ *lchr = 0; break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: if(xw && !xw->bad_device) { /* Return the size of the current window */ XWindowAttributes attr; XGetWindowAttributes(xw->display, xw->window, &attr); if(!xw->bad_device) { rbuf[0] = 0.0; rbuf[1] = (float) (attr.width - 2 * xw->geom.xmargin); rbuf[2] = 0.0; rbuf[3] = (float) (attr.height - 2 * xw->geom.ymargin); } else { rbuf[0] = 0.0; rbuf[1] = (float) xw->geom.width; rbuf[2] = 0.0; rbuf[3] = (float) xw->geom.height; }; } else { rbuf[0] = 0.0; rbuf[1] = XW_DEF_WIDTH; rbuf[2] = 0.0; rbuf[3] = XW_DEF_HEIGHT; }; *nbuf = 4; break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: xw = xw_select_device((int)(rbuf[1]+0.5)); break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: /* * Assign the returned device unit number and success indicator. * Assume failure to open until the workstation is open. */ rbuf[0] = rbuf[1] = 0.0; *nbuf = 2; /* * Prepare the display name. */ if(*lchr >= len) { fprintf(stderr, "%s: Display name too long.\n", XW_IDENT); return; } else { chr[*lchr] = '\0'; }; /* * Connect to the server and create the window. */ xw = new_XWdev(chr, *mode); if(xw==NULL) return; /* * Insert the device in the list of open devices. */ xw_insert_device(xw); rbuf[0] = xw->number; /* Number used to select this device */ rbuf[1] = 1.0; *nbuf = 2; break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: /* * Remove the device from the list of open devices and delete it. */ xw_remove_device(xw); xw = del_XWdev(xw,0); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: if(xw_ok(xw)) { /* * Convert the passed max X and Y coordinates into the total width of the * new window. Add 1/4" margins to the requested area. */ unsigned int width = (int) (rbuf[0] + 0.5) + 2 * xw->geom.xmargin; unsigned int height = (int) (rbuf[1] + 0.5) + 2 * xw->geom.ymargin; /* * Re-size the window if required. */ xw_next_page(xw, width, height); }; break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: if(xw_ok(xw) && xw->pixmap!=None) { XPoint start; XPoint end; xw_xy_to_XPoint(xw, &rbuf[0], &start); xw_xy_to_XPoint(xw, &rbuf[2], &end); XDrawLine(xw->display, xw->pixmap, xw->gc, start.x,start.y, end.x,end.y); xw_mark_modified(xw, start.x, start.y, xw->gcv.line_width); xw_mark_modified(xw, end.x, end.y, xw->gcv.line_width); }; break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: if(xw_ok(xw) && xw->pixmap!=None) { XPoint xp; int radius = xw->gcv.line_width/2; xw_xy_to_XPoint(xw, rbuf, &xp); if(radius < 1) { XDrawPoint(xw->display, xw->pixmap, xw->gc, xp.x, xp.y); } else { unsigned int diameter = radius*2; int x = xp.x - radius; int y = xp.y - radius; XFillArc(xw->display, xw->pixmap, xw->gc, x, y, diameter, diameter, 0, 23040); }; xw_mark_modified(xw, xp.x, xp.y, xw->gcv.line_width); }; break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: if(xw_ok(xw)) xw_set_ci(xw, (int) (rbuf[0] + 0.5)); break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: if(xw_ok(xw)) xw_flush(xw); break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: if(xw_ok(xw)) { XPoint ref; /* Reference cursor coordinates */ XPoint pos; /* Input/Output cursor coordinates */ int mode = 0; /* Cursor band mode */ int posn = 1; /* True to position the cursor */ xw_xy_to_XPoint(xw, rbuf, &pos); xw_xy_to_XPoint(xw, &rbuf[2], &ref); mode = (int)(rbuf[4]+0.5); posn = (int)(rbuf[5]+0.5) > 0; if(xw_read_cursor(xw, mode, posn, &ref, &pos, chr)==0) xw_XPoint_to_xy(xw, &pos, rbuf); else *chr = '\0'; } else { *chr = '\0'; }; *lchr = 1; *nbuf = 2; break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ /* (Not implemented: no alpha screen) */ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ /* (Not implemented: should not be called) */ case 19: break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: if(xw_ok(xw) && xw->pixmap != None) { /* * The first call specifies just the number of vertixes in the polygon. */ if(xw->poly.npoint == 0) { xw->poly.npoint = (int) (rbuf[0] + 0.5); xw->poly.points = (XPoint *) malloc(sizeof(XPoint) * xw->poly.npoint); if(xw->poly.points == NULL) fprintf(stderr, "%s: Insufficient memory for polygon points.\n", XW_IDENT); xw->poly.ndone = 0; /* * The next xw->poly.npoint calls specify the vertexes of the polygon. */ } else { /* * Ignore the points if the above malloc() failed. */ if(xw->poly.points) { XPoint *xp = &xw->poly.points[xw->poly.ndone]; xw_xy_to_XPoint(xw, rbuf, xp); xw_mark_modified(xw, xp->x, xp->y, 1); }; /* * Maintain the count of the number of points, even if no memory for the * points is available. Thus we can just ignore all calls until * xw->poly.ndone == xw->poly.npoint. */ xw->poly.ndone++; /* * On the last call display the filled polygon and release the memory used * to store its vertexes. */ if(xw->poly.ndone >= xw->poly.npoint) { if(xw->poly.points) { XFillPolygon(xw->display, xw->pixmap, xw->gc, xw->poly.points, xw->poly.npoint, Complex, CoordModeOrigin); free((char *)xw->poly.points); xw->poly.points = NULL; }; xw->poly.npoint = 0; }; }; }; break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: if(xw_ok(xw)) { if(!xw->color.initialized) xw_init_colors(xw); xw_set_rgb(xw, (int)(rbuf[0]+0.5), rbuf[1],rbuf[2],rbuf[3]); }; break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: /* * The line width is provided in multiples of 0.005 inches. */ if(xw_ok(xw)) { xw->gcv.line_width = (int)(rbuf[0]*0.005 * xw->geom.xpix_per_inch); XChangeGC(xw->display, xw->gc, (unsigned long) GCLineWidth, &xw->gcv); }; break; /*--- IFUNC=23, Escape --------------------------------------------------*/ /* (Not implemented: ignored) */ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: if(xw_ok(xw) && xw->pixmap != None) { XPoint blc; XPoint trc; xw_xy_to_XPoint(xw, &rbuf[0], &blc); xw_xy_to_XPoint(xw, &rbuf[2], &trc); XFillRectangle(xw->display, xw->pixmap, xw->gc, blc.x, trc.y, (unsigned)(trc.x-blc.x+1), (unsigned)(blc.y-trc.y+1)); xw_mark_modified(xw, blc.x, blc.y, 1); xw_mark_modified(xw, trc.x, trc.y, 1); }; break; /*--- IFUNC=25, ---------------------------------------------------------*/ /* (Not implemented: ignored) */ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: if(xw_ok(xw)) { XPoint start; xw_xy_to_XPoint(xw, rbuf, &start); xw_image_line(xw, &start, &rbuf[2], *nbuf - 2); }; break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: if(xw_ok(xw)) { int ci = (int) (rbuf[0] + 0.5); if(!xw->color.initialized) xw_init_colors(xw); rbuf[1] = xw_xcolor_to_rgb(xw->color.xcolor[ci].red); rbuf[2] = xw_xcolor_to_rgb(xw->color.xcolor[ci].green); rbuf[3] = xw_xcolor_to_rgb(xw->color.xcolor[ci].blue); } else { rbuf[1] = rbuf[2] = rbuf[3] = 0; }; *nbuf = 4; break; /*--- IFUNC=30, Scroll rectangle ----------------------------------------*/ case 30: xw_scroll_rect(xw, rbuf); break; /*--- IFUNC=?, ----------------------------------------------------------*/ default: fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n",XW_IDENT, *ifunc); *nbuf = -1; break; }; /* * After a server error, close the connection to the display and set all * server resources to 'None'. This both prevents calls on bad resources * and by deleting the client communication window, tells the server to * close the connection if the server hasn't already died. */ if(xw && xw->bad_device && xw->display) del_XWdev(xw, 1); return; } /*....................................................................... * Assign a given RGB color representation to a given color index. * * Input: * xw XWdev * The /xw device descriptor. * ci int The color index to assign the color to. Out of range * indexes are quietly ignored. * red float The fractional red brightness 0..1. * green float The fractional green brightness 0..1. * blue float The fractional blue brightness 0..1. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_set_rgb(XWdev *xw, int ci, float red, float green, float blue) #else static int xw_set_rgb(xw, ci, red, green, blue) XWdev *xw; int ci; float red; float green; float blue; #endif { float gray; /* Gray-scale intensity */ XColor *xc; /* The descriptor of the new color */ /* * Device error? */ if(xw->bad_device) return 1; /* * Limit RGB values to be between 0 and 1. */ if(red < 0.0) red = 0.0; if(green < 0.0) green = 0.0; if(blue < 0.0) blue = 0.0; if(red > 1.0) red = 1.0; if(green > 1.0) green = 1.0; if(blue > 1.0) blue = 1.0; /* * Color index in range? */ if(!xw->color.monochrome && ci >= 0 && ci < xw->color.ncol) { /* * Get the color representation descriptor. */ xc = &xw->color.xcolor[ci]; /* * Get the pixel to be assigned the new color representation. */ xc->pixel = xw->color.pixel[ci]; xc->flags = DoRed | DoGreen | DoBlue; xc->pad = 0; /* * Determine the appropriate RGB values for the type of colormap. */ switch(xw->color.vi->class) { case PseudoColor: case StaticColor: case DirectColor: case TrueColor: xc->red = xw_rgb_to_xcolor(red); xc->green = xw_rgb_to_xcolor(green); xc->blue = xw_rgb_to_xcolor(blue); break; case GrayScale: case StaticGray: /* * For gray-scale colormaps the red,green and blue intensities must all be * equal. Weight the colors so that what is brightest to the eye, is also * brighter in grayscale, and so that different colors of equal intensity * appear different in grayscale. Note that the 3 weights must add up to 1.0. * The black and white TV standard says to use 0.3*R+0.59*G+0.11*B. * Unfortunately blue pretty much dissapears in this scheme. The following * is a compromise between making all colors visible and making different * colors look different in grayscale. */ gray = 0.35*red + 0.40*green + 0.25*blue; xc->red = xc->green = xc->blue = xw_rgb_to_xcolor(gray); break; }; /* * Update the recorded range of color indexes whose color representations * have been changed since the last call to xw_update_colors(). */ if(xw->color.nbuff<=0) { xw->color.sbuff = ci; xw->color.nbuff = 1; } else if(ci < xw->color.sbuff) { xw->color.nbuff += xw->color.sbuff - ci; xw->color.sbuff = ci; } else if(ci > xw->color.sbuff + xw->color.nbuff-1) { xw->color.nbuff = ci - xw->color.sbuff + 1; }; /* * Register xw_update_colors() to be called to flush the colors to the * window. */ xw->flush_opcode_fn = (Flush_Opcode_fn) xw_update_colors; }; return 0; } /*....................................................................... * Map floating point color intenisties between 0.0 and 1.0 to XColor * intensities between 0 to 65535. Numbers outside of this range are * limited to the nearest of the two limits. * * Input: * rgb float The PGPLOT normalized intensity to be converted. * Output: * return unsigned short The equivalent XColor RGB intensity. */ #ifdef __STDC__ static int xw_rgb_to_xcolor(float rgb) #else static int xw_rgb_to_xcolor(rgb) float rgb; #endif { long lrgb; /* Use to check output before casting to unsigned short */ /* * Check for limiting input values. */ if(rgb < 0.0) return 0; if(rgb > 1.0) return COLORMULT; /* * Form the xcolor intensity in a long int so that its range can be checked * before casting to unsigned short. */ lrgb = rgb * COLORMULT + 0.5; return lrgb > COLORMULT ? COLORMULT : lrgb; } /*....................................................................... * Map XColor intensities between 0 and 65535 to floating point color * intenisties between 0.0 and 1.0. Numbers outside of this range are * limited to the nearest of the two limits. * * Input: * unsigned short The equivalent XColor RGB intensity. * Output: * return float The PGPLOT normalized intensity to be converted. */ #ifdef __STDC__ static float xw_xcolor_to_rgb(unsigned short urgb) #else static float xw_xcolor_to_rgb(urgb) unsigned short urgb; #endif { float rgb; /* The output value */ rgb = (float) urgb / (float) COLORMULT; /* * Check for limiting input values. */ if(rgb < 0.0) return 0.0; if(rgb > 1.0) return 1.0; return rgb; } /*....................................................................... * Flush color-representation changes made by xw_set_rgb() to the /xw * window. This updates the window colormap. If color index 0 is changed * then the background color is also updated. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * If xw->color.nbuff > 0 { * For(ci=xw->color.sbuff; cicolor.sbuff + xw->color.nbuff; ci++) { * xw->color.pixel[ci] = Color pixel to be changed. * xw->color.xcolor[ci]= Requested color representation. * }; * }; * Output: * If xw->color.nbuff > 0 { * For(ci=xw->color.sbuff; cicolor.sbuff + xw->color.nbuff; ci++) { * xw->color.pixel[ci] = New color pixel if the colormap is readonly. * xw->color.xcolor[ci]= Actual color representation installed. * }; * }; * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_update_colors(XWdev *xw) #else static int xw_update_colors(xw) XWdev *xw; #endif { int bad_colors = 0; /* The number of failed color assignments */ int i; /* * Device error? */ if(xw->bad_device) return 1; /* * Are there any colors to be updated? */ if(!xw->color.monochrome && xw->color.nbuff > 0) { XColor *xc = &xw->color.xcolor[xw->color.sbuff]; unsigned long *pixel = &xw->color.pixel[xw->color.sbuff]; int nbuff = xw->color.nbuff; /* * Install the colors in the color map. */ switch(xw->color.vi->class) { case PseudoColor: case GrayScale: case DirectColor: XStoreColors(xw->display, xw->color.cmap, xc, nbuff); break; case StaticColor: case StaticGray: case TrueColor: for(i=0; ibad_device; i++) { if(XAllocColor(xw->display, xw->color.cmap, &xc[i])) { if(xw->color.initialized) XFreeColors(xw->display, xw->color.cmap, &pixel[i], 1, (long)0); pixel[i] = xc[i].pixel; } else { bad_colors++; }; }; break; }; /* * Device error? */ if(xw->bad_device) return 1; /* * Update the background color? */ if(xw->color.sbuff == 0) XSetWindowBackground(xw->display, xw->window, pixel[0]); /* * Did any of the color assignments fail? */ if(bad_colors > 0) { fprintf(stderr, "%s: Error setting the color representations of %d colors.\n", XW_IDENT, bad_colors); }; }; /* * Reset buffer pointers. */ xw->color.nbuff = 0; xw->color.sbuff = 0; return xw->bad_device!=0; } /*....................................................................... * Set up the visual and colormap for the /xw window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * xw->color.vi The info descriptor of the visual to be used. * xw->color.cmap The ID of the colormap to use. * xw->color.ncol The number of colors available. * xw->color.pixel[0..ncol] The color cell pixel indexes. * xw->color.xcolor[0..ncol]The color pixel definitions. * xw->color.monochrome If true, use black and white instead of the above * values. * xw->color.nbuff The number of buffered color representations. * xw->color.sbuff The index of the first buffered color rep. * * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_visual(XWdev *xw) #else static int xw_get_visual(xw) XWdev *xw; #endif { XEvent event; /* Descriptor of XClientMessage communication descriptor */ XWindowAttributes attr; /* * Device error? */ if(xw->bad_device) return 1; /* * Assume that we have a monochrome display until proven otherwise. */ xw->color.monochrome = 1; xw->color.ncol = 2; xw->color.nbuff = 0; /* No color representations buffered yet */ xw->color.sbuff = 0; /* * Inquire the current visual details of the window. */ if(!XGetWindowAttributes(xw->display, xw->window, &attr)) { fprintf(stderr, "%s: (xw_get_visual) Error getting attributes for window 0x%lx.\n", XW_IDENT, (unsigned long) xw->window); return 1; }; xw->color.vi = xw_visual_info(xw->display, xw->screen, attr.visual); xw->color.cmap = attr.colormap; if(xw->color.vi == NULL || xw->color.cmap == None) return 1; /* * Ask the server for other colormap details. */ event.xclient.message_type = XA_COLORMAP; if(xw_query_server(xw, &event)) return 1; xw->color.monochrome = event.xclient.data.l[0] == None; xw->color.ncol = event.xclient.data.l[1]; /* * Allocate memory for the array of color pixels and color pixel * representations. */ if(xw->color.ncol > 0) { xw->color.pixel = (unsigned long *) malloc(sizeof(unsigned long) * xw->color.ncol); xw->color.xcolor = (XColor *) malloc(sizeof(XColor) * xw->color.ncol); if(xw->color.pixel==NULL || xw->color.xcolor==NULL) xw->color.ncol = 0; }; /* * If we got a colormap, wait for the array of 'ncol' color-cell pixel * indexes to be placed in the PGXWIN_CLIENT_DATA property on the * client communication window, then read it and delete the property. */ if(!xw->color.monochrome) { xw->color.ncol = xw_get_data(xw, (char *) &xw->color.pixel[0], XW_LONG_PROP, (unsigned long) xw->color.ncol); if(xw->color.ncol==0) xw->color.monochrome = 1; }; return 0; } /*....................................................................... * Initialize the color representations in the color table. * xw_get_visual() must have been called prior to calling this function, * so that we have a visual and colormap to define the colors in. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * xw->color.xcolor[0..ncol] The color pixel definitions. * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_init_colors(XWdev *xw) #else static int xw_init_colors(xw) XWdev *xw; #endif { /* * Define the standard PGPLOT line colors (RGB). */ static float ctable[NCOLORS][3] = { {0.0,0.0,0.0}, {1.0,1.0,1.0}, {1.0,0.0,0.0}, {0.0,1.0,0.0}, {0.0,0.0,1.0}, {0.0,1.0,1.0}, {1.0,0.0,1.0}, {1.0,1.0,0.0}, {1.0,0.5,0.0}, {0.5,1.0,0.0}, {0.0,1.0,0.5}, {0.0,0.5,1.0}, {0.5,0.0,1.0}, {1.0,0.0,0.5}, {0.333,0.333,0.333}, {0.667,0.667,0.667} }; int i; /* * Initialize the color-table with the standard PGPLOT line colors. */ if(!xw->color.monochrome) { int ncol = (NCOLORS < xw->color.ncol) ? NCOLORS : xw->color.ncol; for(i=0; icolor.ncol; i++) { float grey = (float)(i-NCOLORS) / (float)(xw->color.ncol-1-NCOLORS); if(xw_set_rgb(xw, i, grey, grey, grey)) return 1; }; }; /* * Flush the new color definitions to the display. */ if(xw_update_colors(xw)) return 1; /* * Record the new colormap state. */ xw->color.initialized = 1; /* * Start with the foreground color set to white. */ if(xw_set_ci(xw, 1)) return 1; return 0; } /*....................................................................... * Get a new PGPLOT window from the server. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * xw->window The new window ID. * return Window The window ID, or 'None' on error. */ #ifdef __STDC__ static Window xw_get_window(XWdev *xw) #else static Window xw_get_window(xw) XWdev *xw; #endif { XEvent event; /* Descriptor of XClientMessage communication descriptor */ int number; /* The requested window number */ /* * Device error? */ if(xw->bad_device) return None; /* * Keep a record of the window number that was requested. */ number = xw->number; /* * Ask the server for other colormap details. */ event.xclient.message_type = XA_WINDOW; event.xclient.data.l[0] = PGXWIN_REVISION; event.xclient.data.l[1] = xw->number; event.xclient.data.l[2] = xw->screen; event.xclient.data.l[3] = xw->disposition; if(xw_query_server(xw, &event)) return None; xw->protocol = event.xclient.data.l[0]; xw->number = event.xclient.data.l[1]; xw->window = event.xclient.data.l[2]; xw->disposition = event.xclient.data.l[3]; /* * Did the server refuse to give us the requested window? */ if(xw->window == None) { if(number != 0) fprintf(stderr, "%s: Window %d is unavailable.\n", XW_IDENT, number); else fprintf(stderr, "%s: Failed to acquire a PGPLOT window.\n", XW_IDENT); }; return xw->window; } /*....................................................................... * Get a new pixmap from the server. This should be called whenever a * new page is started. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * xw->pixmap The new pixmap ID. * return Pixmap The pixmap ID, or 'None' on error. */ #ifdef __STDC__ static Pixmap xw_get_pixmap(XWdev *xw) #else static Pixmap xw_get_pixmap(xw) XWdev *xw; #endif { XEvent event; /* Descriptor of XClientMessage communication descriptor */ /* * Device error? */ if(xw->bad_device) return None; /* * Ask the server for other colormap details. */ event.xclient.message_type = XA_PIXMAP; event.xclient.data.l[0] = xw->color.monochrome ? BlackPixel(xw->display, xw->screen) : xw->color.pixel[0]; if(xw_query_server(xw, &event)) return 1; xw->pixmap = event.xclient.data.l[0]; /* * Did the server fail to give us the requested pixmap? */ if(xw->pixmap == None) fprintf(stderr, "%s: Failed to allocate pixmap.\n", XW_IDENT); return xw->pixmap; } /*....................................................................... * Get the IDs of the normal and active cursors. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * xw->norm_cursor The ID of the idle cursor. * xw->live_cursor The ID of the live cursor. * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_cursors(XWdev *xw) #else static int xw_get_cursors(xw) XWdev *xw; #endif { XEvent event; /* Descriptor of XClientMessage communication descriptor */ /* * Device error? */ if(xw->bad_device) return 1; /* * Ask the server for other colormap details. */ event.xclient.message_type = XA_CURSOR; if(xw_query_server(xw, &event)) return 1; xw->norm_cursor = event.xclient.data.l[0]; xw->live_cursor = event.xclient.data.l[1]; xw->crosshair = event.xclient.data.l[2]; return xw->bad_device!=0; } /*....................................................................... * Agree upon a window geometry with the PGPLOT /xw server. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. Only the display * and screen members are required. * mask int A bit mask to specify which values have been provided * and how they should be interpretted. The mask is the * union of the following: * WidthValue - Use the given width value. * HeightValue - Use the given height value. * XValue - Use the given value of 'x'. * YValue - Use the given value of 'y'. * XNegative - x is wrt the right of the display. * YNegative - y is wrt the left of the display. * x int The left edge of the window. * y int The top edge of the window. * width unsigned The width of the window. * height unsigned The height of the window. * Output: * xw->geom XWgeom The new window geometry. * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_new_geom(XWdev *xw, int x, int y, unsigned int width, unsigned int height, int mask) #else static int xw_new_geom(xw, x, y, width, height, mask) XWdev *xw; int x; int y; unsigned int width; unsigned int height; int mask; #endif { XEvent event; /* Descriptor of XClientMessage communication descriptor */ unsigned int d_pix_width; /* Display width in pixels */ unsigned int d_pix_height; /* Display height in pixels */ unsigned int d_mm_width; /* Display width in mm */ unsigned int d_mm_height; /* DIsplay height in mm */ int xw_mask=0; /* PGXWIN communication version of 'mask' */ /* * Device error? */ if(xw->bad_device) return 1; /* * Get the PGXWIN_GEOMETRY transaction atom. */ if(xw->geom.geom_atom == None) xw->geom.geom_atom = XInternAtom(xw->display, "PGXWIN_GEOMETRY", False); /* * Translate the local bitmask values to a PGXWIN defined bitmask for * communication, since different Xlibs may define the XParseGeometry * bitmask values differently. They will be translated back in the server. */ if(mask & WidthValue) xw_mask |= XW_WidthValue; if(mask & HeightValue) xw_mask |= XW_HeightValue; if(mask & XValue) xw_mask |= XW_XValue; if(mask & YValue) xw_mask |= XW_YValue; if(mask & XNegative) xw_mask |= XW_XNegative; if(mask & YNegative) xw_mask |= XW_YNegative; /* * Send geometry prefences to the server and receive the resulting * geometry. */ event.xclient.message_type = xw->geom.geom_atom; event.xclient.data.l[0] = x; event.xclient.data.l[1] = y; event.xclient.data.l[2] = width; event.xclient.data.l[3] = height; event.xclient.data.l[4] = xw_mask; if(xw_query_server(xw, &event)) return 1; /* * Record the geometry that the server sent. */ xw->geom.x = event.xclient.data.l[0]; xw->geom.y = event.xclient.data.l[1]; xw->geom.width = event.xclient.data.l[2]; xw->geom.height = event.xclient.data.l[3]; /* * Determine the current display width and height in mm and pixels. */ d_pix_width = DisplayWidth(xw->display, xw->screen); d_mm_width = DisplayWidthMM(xw->display, xw->screen); d_pix_height = DisplayHeight(xw->display, xw->screen); d_mm_height = DisplayHeightMM(xw->display, xw->screen); /* * Determine the device resolution in pixels per inch. */ xw->geom.xpix_per_inch = 25.4 * ((double)d_pix_width / (double)d_mm_width); xw->geom.ypix_per_inch = 25.4 * ((double)d_pix_height / (double)d_mm_height); /* * Determine the number of pixels needed to form a 1/4" margin around the * the plot area. */ xw->geom.xmargin = (int) (0.25 * xw->geom.xpix_per_inch + 0.5); xw->geom.ymargin = (int) (0.25 * xw->geom.ypix_per_inch + 0.5); /* * Determine the pixel indexes that enclose an area bounded by 1/4" margins. */ xw->geom.xmin = xw->geom.xmargin; xw->geom.xmax = xw->geom.width - xw->geom.xmargin; xw->geom.ymin = xw->geom.ymargin; xw->geom.ymax = xw->geom.height - xw->geom.ymargin; return 0; } /*....................................................................... * Instate the given cursor type. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * norm int If norm!=0 instate the normal idle cursor. * If norm==0 instate the active cursor. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_set_cursor(XWdev *xw, int norm) #else static int xw_set_cursor(xw, norm) XWdev *xw; int norm; #endif { Cursor cursor; /* The ID of the cursor to be instated */ /* * Device error? */ if(xw->bad_device) return 1; /* * Get the cursor ID and color to use. */ cursor = norm ? xw->norm_cursor : xw->live_cursor; /* * Register the cursor to the window. */ XDefineCursor(xw->display, xw->window, cursor); if(xw->bad_device) return 1; XFlush(xw->display); return xw->bad_device!=0; } /*....................................................................... * Clear the window and pixmap to start a new page. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_clear(XWdev *xw) #else static int xw_clear(xw) XWdev *xw; #endif { unsigned long fg; /* Saved foreground color */ /* * Device error? */ if(xw->bad_device) return 1; /* * We are about to change the current foreground color, so save the * current value to be re-instated shortly. */ fg = xw->gcv.foreground; /* * Clear the pixmap by drawing an opaque rectangle over it in the background * color. */ xw_set_ci(xw, 0); if(xw->pixmap != None) { XFillRectangle(xw->display, xw->pixmap, xw->gc, 0, 0, xw->geom.width, xw->geom.height); if(xw->bad_device) return 1; }; /* * Re-instate the foreground color. */ xw->gcv.foreground = fg; XSetForeground(xw->display, xw->gc, xw->gcv.foreground); if(xw->bad_device) return 1; /* * Mark the pixmap as unmodified. */ xw->update.modified = 0; /* * Clear the window itself. */ XClearWindow(xw->display, xw->window); if(xw->bad_device) return 1; XFlush(xw->display); if(xw->bad_device) return 1; return 0; } /*....................................................................... * Set the foreground color. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * ci int The PGPLOT color index to instate as the foreground * color. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_set_ci(XWdev *xw, int ci) #else static int xw_set_ci(xw, ci) XWdev *xw; int ci; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Assign white to out-of range color indexes. */ if(ci < 0 || ci >= xw->color.ncol) ci = 1; /* * Determine the color pixel associated with the given color index. */ if(xw->color.monochrome) { xw->gcv.foreground = ci==1 ? WhitePixel(xw->display, xw->screen) : BlackPixel(xw->display, xw->screen); } else { xw->gcv.foreground = xw->color.pixel[ci]; }; /* * Instate the new foreground color. */ XSetForeground(xw->display, xw->gc, xw->gcv.foreground); if(xw->bad_device) return 1; return 0; } /*....................................................................... * Update the vertices of the rectangular area that has been modified * since the last time the window was updated from the pixmap. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * x int The x-axis pixel index that the rectangular update area * must be extended to include. * y int The y-axis pixel index that the rectangular update area * must be extended to include. * diameter int The diameter of the locus in pixels. For line or * point drawing operations this is usually the line width. */ #ifdef __STDC__ static void xw_mark_modified(XWdev *xw, int x, int y, int diameter) #else static void xw_mark_modified(xw, x, y, diameter) XWdev *xw; int x; int y; int diameter; #endif { int radius = diameter/2; /* * Expand the current rectangle to include point (x,y). */ if(xw->update.modified) { if(x - radius < xw->update.xmin) xw->update.xmin = x - radius; if(x + radius > xw->update.xmax) xw->update.xmax = x + radius; if(y - radius < xw->update.ymin) xw->update.ymin = y - radius; if(y + radius > xw->update.ymax) xw->update.ymax = y + radius; } else { xw->update.xmin = x - radius; xw->update.xmax = x + radius; xw->update.ymin = y - radius; xw->update.ymax = y + radius; xw->update.modified = 1; }; return; } /*....................................................................... * Flush changes to the pixmap to the window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_flush(XWdev *xw) #else static int xw_flush(xw) XWdev *xw; #endif { if(xw->bad_device) return 1; /* * Flush buffered opcodes if necessary. */ if(xw->flush_opcode_fn != (Flush_Opcode_fn) 0) { (*xw->flush_opcode_fn)(xw); xw->flush_opcode_fn = (Flush_Opcode_fn) 0; if(xw->bad_device) return 1; }; /* * Copy the modified rectangular area of the pixmap to the /xw window. */ if(xw->update.modified) { /* * Enforce bounds on the area to be updated. */ if(xw->update.xmin < 0) xw->update.xmin = 0; if(xw->update.ymin < 0) xw->update.ymin = 0; if(xw->update.xmax > xw->geom.width - 1) xw->update.xmax = xw->geom.width - 1; if(xw->update.ymax > xw->geom.height - 1) xw->update.ymax = xw->geom.height - 1; /* * Copy the area to be updated from the pixmap to the window. */ if(xw->pixmap != None && !xw->bad_device) { XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, xw->update.xmin, xw->update.ymin, (unsigned) (xw->update.xmax - xw->update.xmin + 1), (unsigned) (xw->update.ymax - xw->update.ymin + 1), xw->update.xmin, xw->update.ymin); if(xw->bad_device) return 1; }; xw->update.modified = 0; }; XFlush(xw->display); if(xw->bad_device) return 1; return 0; } /*....................................................................... * Open a /xw window and return an initialized /xw PGPLOT device descriptor. * * Input: * display char * A '\0' terminated string containing the name of * the display. * mode int The type of window to open. * 1 - None-persistent window. * 2 - Persistent window. * Output: * return XWdev * THe PGPLOT /xw device descriptor, or NULL on error. */ #ifdef __STDC__ static XWdev *new_XWdev(char *display, int mode) #else static XWdev *new_XWdev(display, mode) char *display; int mode; #endif { XWdev *xw; /* The descriptor to be returned */ /* * Allocate the descriptor. */ xw = (XWdev *) malloc(sizeof(XWdev)); if(xw==NULL) return del_XWdev(xw,0); /* * Initialize all members of the descriptor at least to the point at which * the descriptor can safely be sent to del_XWdev(xw,0). All pointers must * be assigned NULL and XIDs assigned None, so that del_XWdev() knows what * hasn't been allocated yet. */ xw->display = NULL; xw->parent = None; xw->window = None; xw->client = None; xw->server = None; xw->number = 0; xw->screen = 0; xw->disposition = mode==2 ? XW_PERSIST : XW_DELETE; xw->bad_device = 0; xw->last_error = 0; xw->pixmap = None; xw->color.cmap = None; xw->norm_cursor = None; xw->live_cursor = None; xw->crosshair = 0; xw->poly.points = NULL; xw->poly.ndone = xw->poly.npoint = 0; xw->gc = NULL; xw->color.vi = NULL; xw->color.cmap = None; xw->color.ncol = 0; xw->color.monochrome = 1; xw->color.pixel = NULL; xw->color.xcolor = NULL; xw->color.initialized = 0; xw->color.nbuff = 0; xw->color.sbuff = 0; xw->geom.geom_atom = None; xw->update.modified = 0; xw->event.mask = NoEventMask; xw->event.no_buttons = 0; xw->image.xi = NULL; xw->last_opcode = 0; xw->flush_opcode_fn = (Flush_Opcode_fn) 0; /* * See if the device name is prefixed with a window number. * The device name is encoded as [window@][display] | [window]. * Leave the trailing display name in display. */ { char *endp; long number = strtol(display, &endp, 10); switch(*endp) { case '@': display = endp+1; xw->number = number; break; case '\0': display = endp; xw->number = number; break; }; }; /* * Treat -ve window numbers as equivalent to 0. */ if(xw->number < 0) xw->number = 0; /* * Open a connection to the X display server. */ xw->display = XOpenDisplay(display); if(xw->display==NULL) { fprintf(stderr, "%s: cannot connect to X server [%s]\n", XW_IDENT, XDisplayName(display)); return del_XWdev(xw,0); }; /* * Install an error handler for non-fatal errors. If we don't do this then * Xlib will do its own error handling, which includes killing the program. */ XSetErrorHandler(xw_error); /* * Get the index of the screen cited in the display string. */ xw->screen = DefaultScreen(xw->display); /* * Also record the parent window ID. */ xw->parent = RootWindow(xw->display, xw->screen); /* * Create a simple window for communication with the server. */ xw->client = XCreateSimpleWindow(xw->display, xw->parent, 0, 0, (unsigned)1, (unsigned)1, (unsigned)1, BlackPixel(xw->display, xw->screen), BlackPixel(xw->display, xw->screen)); if(xw->client == None || xw->bad_device) { fprintf(stderr, "%s: Unable to create window.\n", XW_IDENT); return del_XWdev(xw,0); }; /* * We want notice of changes of the PGXWIN_CLIENT_DATA property. */ XSelectInput(xw->display, xw->client, (long) PropertyChangeMask); if(xw->bad_device) return del_XWdev(xw,0); /* * Get the server selection atom and the client data transfer atom. */ xw->server_atom = XInternAtom(xw->display, PGXWIN_SERVER, False); if(xw->bad_device) return del_XWdev(xw,0); xw->client_data = XInternAtom(xw->display, "PGXWIN_CLIENT_DATA", False); if(xw->bad_device) return del_XWdev(xw,0); /* * Get the server window ID. */ if(xw_get_server(xw) == None) return del_XWdev(xw,0); /* * Get a new PGPLOT window. */ if(xw_get_window(xw) == None) return del_XWdev(xw,0); /* * We want to know if the PGPLOT window gets destroyed. */ if(xw_add_events(xw, (long) StructureNotifyMask)) return del_XWdev(xw,0); /* * Get the visual and colormap of the window. */ if(xw_get_visual(xw)) return del_XWdev(xw,0); /* * Set/get the current geometry for the window. */ if(xw_new_geom(xw, 0,0, 0,0, 0)) return del_XWdev(xw,0); /* * Get the IDs of the normal and active cursors. */ if(xw_get_cursors(xw)) return del_XWdev(xw,0); /* * Instate the normal cursor for the window. */ if(xw_set_cursor(xw, 1)) return del_XWdev(xw,0); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ xw->gcv.line_width = 1; xw->gcv.cap_style = CapRound; xw->gcv.join_style = JoinRound; xw->gcv.fill_rule = EvenOddRule; xw->gcv.graphics_exposures = False; xw->gcv.foreground = WhitePixel(xw->display, xw->screen); xw->gc = XCreateGC(xw->display, xw->window, (unsigned long) (GCLineWidth | GCCapStyle | GCJoinStyle | GCFillRule | GCGraphicsExposures | GCForeground), &xw->gcv); if(xw->gc==NULL || xw->bad_device) { fprintf(stderr, "%s: Failed to allocate graphical context.\n", XW_IDENT); return del_XWdev(xw,0); }; /* * Allocate the buffers that will be used to compose a line * of pixels. */ if(xw_get_image(xw, XW_IMAGE_LEN)) return del_XWdev(xw,0); /* * Return the initialized descriptor for use. */ return xw; } /*....................................................................... * Delete a PGPLOT /xw device and its descriptor. * * Input: * xw XWdev * The descriptor of the device to be deleted. * partial int 0 - Normal deletion - delete everything. * 1 - Close the display connection and mark all * resources as deleted but don't delete the * container - also set xw->bad_device==1. * Output: * return XWdev * Allways NULL. Use like xw = del_XWdev(xw,0); */ #ifdef __STDC__ static XWdev *del_XWdev(XWdev *xw, int partial) #else static XWdev *del_XWdev(xw, partial) XWdev *xw; int partial; #endif { if(xw) { /* * Mark the device as unusable as the first operation so that if * any X errors are generated during cleanup, they are not reported. */ xw->bad_device = 1; /* * Delete the graphical context descriptor. */ if(xw->gc) XFreeGC(xw->display, xw->gc); xw->gc = NULL; /* * Delete the image buffers. */ if(xw->image.xi) XDestroyImage(xw->image.xi); xw->image.xi = NULL; /* * Check for un-freed polygon points. */ if(xw->poly.points) free((char *)xw->poly.points); xw->poly.points = NULL; /* * Zap the arrays of color pixels and color pixel definitions. */ if(xw->color.pixel) free((char *)xw->color.pixel); if(xw->color.xcolor) free((char *)xw->color.xcolor); /* * Discard the visual info descriptor. */ if(xw->color.vi) XFree((char *)xw->color.vi); /* * Close the connection to the display server - this will also delete * all X-resources. */ if(xw->display != NULL) { /* * Explicitly clear the local event mask for the PGPLOT /xw window in case * XCloseDisplay fails to do this. */ if(xw->window != None) XSelectInput(xw->display, xw->window, (long) NoEventMask); XCloseDisplay(xw->display); xw->display = NULL; }; /* * Mark effected resources as deleted. */ xw->client = xw->server = xw->window = xw->parent = None; xw->server_atom = xw->client_data = None; xw->pixmap = xw->norm_cursor = xw->live_cursor = None; xw->flush_opcode_fn = (Flush_Opcode_fn) 0; xw->update.modified = 0; /* * Delete the descriptor if required. */ if(!partial) { free((char *)xw); xw = NULL; }; }; return xw; } /*....................................................................... * Before using a given /xw device descriptor call this function to check * that it is usable. If it isn't, 0 will be returned and you should not * attempt to use the descriptor. If the descriptor is NULL an error * message will be presented. * * Input: * xw XWdev * The device descriptor to be checked. * Output: * return int 1 - Descriptor OK. * 0 - Error - don't use /xw. */ #ifdef __STDC__ static int xw_ok(XWdev *xw) #else static int xw_ok(xw) XWdev *xw; #endif { if(xw==NULL) { fprintf(stderr, "%s: Device not open.\n", XW_IDENT); return 0; }; /* * If the window is marked as unusable, it must have been set that way * after an error was detected. Assume that the error must already * have been reported. */ if(xw->bad_device) return 0; return 1; } /*....................................................................... * Present the active cursor, wait for the user to press a button or * keyboard key, then retrack the active cursor and return the cursor * position and key pressed. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * mode int 0 - No rubber banding. * 1 - Maintain a rectangle outline with opposing * vertexes at (xin,yin) and the cursor. * 2 - Maintain a line between (xin,yin) and the cursor. * posn int 0 - Don't attempt to position the cursor. * 1 - Do try to pre-position the cursor. * ref XPoint * The reference position of the cursor (can be the same * as 'pos'). * Input/Output: * pos XPoint * The start position of the cursor. On output this is the * selected position of the cursor. * Output: * key char * If key!=NULL, the selection key will be assigned to * the caller's variable pointed to by key. * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_read_cursor(XWdev *xw, int mode, int posn, XPoint *ref, XPoint *pos, char *key) #else static int xw_read_cursor(xw, mode, posn, ref, pos, key) XWdev *xw; int mode; int posn; XPoint *ref; XPoint *pos; char *key; #endif { int finished = 0; /* True when cursor succesfully read */ XEvent event; /* The latest event */ XPoint last; /* Last recorded position of cursor */ Band *bc=NULL; /* Band-cursor descriptor */ int warped=0; /* Zero until the cursor has been positioned */ /* * Device error? */ if(xw->bad_device) return 1; /* * Ensure that the input positions are within the pixmap and window bounds. */ if(xw_bound_cursor(xw, ref) || xw_bound_cursor(xw, pos)) return 1; /* * Present the active cursor. */ if(xw_set_cursor(xw, 0)) return xw_end_cursor(xw, bc, 1); /* * Make sure that the window is up to date. */ if(xw_flush(xw)) return xw_end_cursor(xw, bc, 1); /* * De-iconify and bring the window to the foreground. */ XMapRaised(xw->display, xw->window); if(xw->bad_device) return xw_end_cursor(xw, bc, 1); XSync(xw->display, False); if(xw->bad_device) return xw_end_cursor(xw, bc, 1); /* * Set up for modes that maintain elastic lines following the cursor. */ if((bc=xw_new_Band(xw, mode, ref))==NULL) return xw_end_cursor(xw, bc, 1); /* * If the cursor is in the window, locate its position, * after warping if requested. */ if(xw_locate_cursor(xw, pos, posn, &last)) { warped = 1; /* * Draw the cursor. */ if(xw->bad_device || xw_bound_cursor(xw, &last) || xw_draw_cursor(xw, bc, &last)) return xw_end_cursor(xw, bc, 1); }; /* * Discard un-handled ButtonPress, KeyPress and MotionNotify events. */ while(xw_check_window_event(xw, xw->window, (long) (ButtonPressMask | KeyPressMask | PointerMotionMask), &event)); if(xw->bad_device) return xw_end_cursor(xw, bc, 1); /* * Loop for cursor events. */ while(!finished) { /* * Handle the next selected event. */ if(xw_next_event(xw, &event)) return xw_end_cursor(xw, bc, 1); switch(event.type) { case Expose: if(xw_expose(xw, &event)) return xw_end_cursor(xw, bc, 1); break; case ButtonPress: /* * Return the position at which the cursor was selected. */ pos->x = event.xbutton.x; pos->y = event.xbutton.y; /* * Return the key alias of the button that selected the cursor. */ if(key) { switch(event.xbutton.button) { case Button1: *key = 'A'; break; case Button2: *key = 'D'; break; default: *key = 'X'; break; }; }; finished = 1; break; case KeyPress: { char buffer[10]; /* Buffer to read key definition into */ KeySym keysym; /* Key code of pressed keyboard key */ int nret; /* The number of characters in buffer[] */ /* * Get the ASCII encoding associated with the key. */ nret = XLookupString((XKeyEvent *)&event, buffer, (int) (sizeof(buffer)/sizeof(char)), &keysym, NULL); if(xw->bad_device) return xw_end_cursor(xw, bc, 1); /* * Ignore modifier keys and all but single character keys. */ if(nret==1 && (keysym < XK_Shift_L || keysym > XK_Hyper_R)) { pos->x = event.xkey.x; pos->y = event.xkey.y; if(key) *key = buffer[0]; finished = 1; }; /* * Check for arrow keys. */ switch(keysym) { #ifdef XK_KP_Left case XK_KP_Left: #endif case XK_Left: #ifdef XK_KP_Right case XK_KP_Right: #endif case XK_Right: #ifdef XK_KP_Up case XK_KP_Up: #endif case XK_Up: #ifdef XK_KP_Down case XK_KP_Down: #endif case XK_Down: if(xw_shift_cursor(xw, keysym, event.xkey.state)) return xw_end_cursor(xw, bc, 1); break; }; }; break; case EnterNotify: /* * The cursor may still be drawn if a button was pressed when the * cursor was last moved out of the window. The resulting * passive grab will have continued to deliver motion events to * the PGPLOT window. */ if(xw_erase_cursor(xw, bc)) return xw_end_cursor(xw, bc, 1); /* * If the cursor is in the window, locate its position. If this is * the first time that the cursor has been in the window and warping * has been requested, this also inolves pre-positioning the cursor * and setting input focus. */ if(xw_locate_cursor(xw, pos, posn && !warped, &last)) { warped = 1; /* * Draw the cursor. */ if(xw->bad_device || xw_bound_cursor(xw, &last) || xw_draw_cursor(xw, bc, &last)) return xw_end_cursor(xw, bc, 1); }; break; case LeaveNotify: if(xw_erase_cursor(xw, bc)) return xw_end_cursor(xw, bc, 1); break; case MotionNotify: /* * Discard all but the last MotionNotify event. */ while(xw_check_window_event(xw, xw->window, (long)(PointerMotionMask), &event)); if(xw->bad_device || xw_erase_cursor(xw, bc)) return xw_end_cursor(xw, bc, 1); last.x = event.xmotion.x; last.y = event.xmotion.y; if(xw_bound_cursor(xw, &last) || xw_draw_cursor(xw, bc, &last)) return xw_end_cursor(xw, bc, 1); break; default: break; }; }; /* * Clean up. */ return xw_end_cursor(xw, bc, xw->bad_device!=0); } /*....................................................................... * This is a private function of xw_read_cursor(). If the user has just * pressed one of the keyboard or keypad arrow keys, it moves the cursor * by one pixel in the corresponding direction. If one of the shift keys * is also held down, then the cursor is moved by ARROW_KEY_VELOCITY * pixels instead of one. If the resulting shift would move the cursor * out of the bounds of the pgplot window pixmap, then the motion is * aborted. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * keysym KeySym The key symbol returned by XLookupString() wrt * the arrow-button key-press. * modifiers unsigned The Event::xkey.state key-modifier mask * associated with the key-press. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_shift_cursor(XWdev *xw, KeySym keysym, unsigned int modifiers) #else static int xw_shift_cursor(xw, keysym, modifiers) XWdev *xw; KeySym keysym; unsigned int modifiers; #endif { Window p_child; /* The child window that contains the pointer */ int p_win_x, p_win_y; /* The pointer coordinates wrt xw->window */ int p_root_x, p_root_y; /* The pointer coordinates wrt the root window */ Window p_root_win; /* The root window that contains the cursor */ unsigned int p_mask; /* The bit-mask of button states etc.. */ int dx=0; /* The amount to move the cursor in X */ int dy=0; /* The amount to move the cursor in Y */ /* * Determine the current position of the cursor. */ XQueryPointer(xw->display, xw->window, &p_root_win, &p_child, &p_root_x, &p_root_y, &p_win_x, &p_win_y, &p_mask); if(xw->bad_device) return 1; /* * Work out the position increments in x and y. */ switch(keysym) { #ifdef XK_KP_Left case XK_KP_Left: #endif case XK_Left: dx = -1; break; #ifdef XK_KP_Right case XK_KP_Right: #endif case XK_Right: dx = 1; break; #ifdef XK_KP_Up case XK_KP_Up: #endif case XK_Up: dy = -1; break; #ifdef XK_KP_Down case XK_KP_Down: #endif case XK_Down: dy = 1; break; default: return 0; break; }; /* * If one of the shift keys is held down, increase the size of the * move to ARROW_KEY_VELOCITY pixels in the specified direction. */ if(modifiers & ShiftMask) { dx *= ARROW_KEY_VELOCITY; dy *= ARROW_KEY_VELOCITY; }; /* * Determine the final position of the pointer wrt the top left corner * of the window. */ p_win_x += dx; p_win_y += dy; /* * Abort the shift operation if the final position lies outside of the * bounds of the pgplot window pixmap. Note that this simple test doesn't * take account of the fact that another window may lie over the pgplot * window, or that the window may have been resized to a smaller size * than the pixmap. To do this properly one would have to perform the * move, then check for LeaveNotify events and put the cursor back if * one was detected. This would be hard to code without breaking * xw_read_cursor() which also wants LeaveNotify events, would be * slower to operate and would be unavoidably subject to race conditions. */ if(p_win_x < 0 || p_win_x >= xw->geom.width || p_win_y < 0 || p_win_y >= xw->geom.height) return 0; /* * Move the cursor to the new location. */ XWarpPointer(xw->display, None, xw->window, 0, 0, 0, 0, p_win_x, p_win_y); if(xw->bad_device) return 1; return 0; } /*....................................................................... * Private return function of xw_read_cursor(). * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * bc Band * The cursor banding descriptor to be deleted. * status int Required xw_read_cursor() return status. * Output: * return int The value of 'status'. */ #ifdef __STDC__ static int xw_end_cursor(XWdev *xw, Band *bc, int status) #else static int xw_end_cursor(xw, bc, status) XWdev *xw; Band *bc; int status; #endif { if(bc) { if(xw_erase_cursor(xw, bc)) status=1; if(xw_flush(xw)) status=1; bc = xw_del_Band(xw, bc); }; if(xw_set_cursor(xw,1)) status=1; return status; } /*....................................................................... * Convert from the coordinates sent by PGPLOT in rbuf[...] to an * X-windows point in the coordinate system of the window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * xy float [2] Array of two floats containing PGPLOT coordinates * arranged as x followed by y. * Output: * xp XPoint * The converted coordinates will be assigned to xp->x * and xp->y. */ #ifdef __STDC__ static void xw_xy_to_XPoint(XWdev *xw, float *xy, XPoint *xp) #else static void xw_xy_to_XPoint(xw, xy, xp) XWdev *xw; float *xy; XPoint *xp; #endif { xp->x = xw->geom.xmin + (int)(xy[0] + 0.5); xp->y = xw->geom.ymax - (int)(xy[1] + 0.5); } /*....................................................................... * Convert from window pixel coordinates to PGPLOT coordinates, in a * form that can be returned to PGPLOT via rbuf[...]. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * xp XPoint * The window pixel-coordinates to be converted. * Output: * xy float [2] Output array of two floats in which to place the * PGPLOT coordinates, arranged as x followed by y. */ #ifdef __STDC__ static void xw_XPoint_to_xy(XWdev *xw, XPoint *xp, float *xy) #else static void xw_XPoint_to_xy(xw, xp, xy) XWdev *xw; XPoint *xp; float *xy; #endif { xy[0] = (float) (xp->x - xw->geom.xmin); xy[1] = (float) (xw->geom.ymax - xp->y); } /*....................................................................... * Start a new page by clearing and possibly re-sizing the given /xw * window and its pixmap. If the current size of the window is equal * to the requested new size, then only the window clearing operation * will be performed. * * Input: * xw XWdev * The PGPLOT /xw device descriptor of the window to be * resized. * width unsigned The new width for the re-sized window (pixels). * height unsigned The new height for the re-sized window (pixels). * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_next_page(XWdev *xw, unsigned int width, unsigned int height) #else static int xw_next_page(xw, width, height) XWdev *xw; unsigned int width; unsigned int height; #endif { int need_resize; /* True if the current pixmap size needs to be changed */ /* * Device error? */ if(xw->bad_device) return 1; /* * Does the pixmap need to be resized? */ need_resize = width != xw->geom.width || height != xw->geom.height; /* * Establish the new geometry with the server. */ if(need_resize) { if(xw_new_geom(xw, 0,0, width,height, (WidthValue|HeightValue))) return 1; }; /* * Reset the colormap color representations if necessary. */ if(!xw->color.initialized && xw_init_colors(xw)) return 1; /* * Allocate a new pixmap? */ if(xw->pixmap==None || need_resize) { xw_get_pixmap(xw); if(xw->bad_device) return 1; /* * If a new pixmap is not required, simply clear the window and pixmap. */ } else { if(xw_clear(xw)) return 1; /* * Also ensure that the window has the same size as the pixmap. */ XResizeWindow(xw->display, xw->window, xw->geom.width, xw->geom.height); }; return 0; } /*....................................................................... * Draw a horizontal line of pixels at a given location, from a float * array of PGPLOT color indexes. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * start XPoint * The position to start the line at. * cells float * An array of ncell pixel PGPLOT color indexes. * ncell int The number of cells in cells[]. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_image_line(XWdev *xw, XPoint *start, float *cells, int ncell) #else static int xw_image_line(xw, start, cells, ncell) XWdev *xw; XPoint *start; float *cells; int ncell; #endif { int ndone; /* The number of pixels drawn so far */ int i; /* * Device error? */ if(xw->bad_device) return 1; /* * Quietly ignore the call if we don't have a pixmap. */ if(xw->pixmap != None) { /* * Draw up to xw->image.npix pixels at a time. This is the size of the * xw->image.buff[] buffer. */ for(ndone=0; !xw->bad_device && ndonecolor.vi->depth == 8) { for(i=0; iimage.xi->data[i] = xw->color.pixel[(int)(cells[ndone+i] + 0.5)]; } else { for(i=0; iimage.xi, i, 0, xw->color.pixel[(int) (cells[ndone+i] + 0.5)]); }; }; /* * Display the image. */ XPutImage(xw->display, xw->pixmap, xw->gc, xw->image.xi, 0, 0, start->x+ndone, start->y, (unsigned) nimage, (unsigned) 1); }; /* * Extend the region to be updated on the next flush. */ xw_mark_modified(xw, start->x, start->y, 1); xw_mark_modified(xw, start->x + ncell - 1, start->y, 1); }; if(xw->bad_device) return 1; return 0; } /*....................................................................... * Call this function when an Expose event is received. It will then * re-draw the exposed region from the xw->pixmap. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * event XEvent * The expose event. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_expose(XWdev *xw, XEvent *event) #else static int xw_expose(xw, event) XWdev *xw; XEvent *event; #endif { /* * Device error? */ if(xw->bad_device) return 1; if(event->type == Expose && xw->pixmap != None) { XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, event->xexpose.x, event->xexpose.y, (unsigned) event->xexpose.width, (unsigned) event->xexpose.height, event->xexpose.x, event->xexpose.y); if(xw->bad_device) return 1; XFlush(xw->display); if(xw->bad_device) return 1; }; return 0; } /*....................................................................... * Set up for a band cursor and return its descriptor. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * mode int 0 - No band cursor. * 1 - Line between reference position and cursor. * 2 - Rectangle drawn with opposite corners at reference * and cursor position. * ref XPoint * The reference position. * Output: * return Band * A pointer to a static internal container of cursor * resources. Call xw_del_Band() to release these resources * and return the event mask to normal. */ #ifdef __STDC__ static Band *xw_new_Band(XWdev *xw, int mode, XPoint *ref) #else static Band *xw_new_Band(xw, mode, ref) XWdev *xw; int mode; XPoint *ref; #endif { static Band band; /* Return container */ long event_mask=0; /* Bit map of events to be caught */ /* * Device error? */ if(xw->bad_device) return NULL; /* * Initialize values at least to the point at which xw_del_Band() can * safely be called. */ band.line_width = xw->gcv.line_width; band.mode = mode; band.ref = *ref; band.end = *ref; /* * All cursor types require us to catch the following events. */ event_mask = ExposureMask | KeyPressMask | ButtonPressMask | EnterWindowMask | LeaveWindowMask; /* * Set up for a band cursor? */ if(band.mode != 0 || xw->crosshair) { /* * Arrange for the band cursor to be drawn with a line width of 0. */ if(band.line_width != 0) { XGCValues attr; band.line_width = attr.line_width = 0; XChangeGC(xw->display, xw->gc, (unsigned long) GCLineWidth, &attr); if(xw->bad_device) return NULL; }; /* * Select for cursor motion events along with the normal events. */ event_mask |= PointerMotionMask; }; /* * Register the additional event types that are now to be caught. */ if(xw_add_events(xw, event_mask)) return NULL; return &band; } /*....................................................................... * Release band cursor resources and return the window event mask to * its normal state. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * bc Band * The band-cursor descriptor. * Output: * return Band * Always NULL. */ #ifdef __STDC__ static Band *xw_del_Band(XWdev *xw, Band *bc) #else static Band *xw_del_Band(xw, bc) XWdev *xw; Band *bc; #endif { /* * Prevent the event buffer from overflowing by removing superflous events * from the set of those to be caught. */ xw_rem_events(xw, (long) (ExposureMask | KeyPressMask | ButtonPressMask | EnterWindowMask | LeaveWindowMask | PointerMotionMask)); /* * If the line width was changed for rubber banding, re-instate the * original line width. */ if(bc->line_width != xw->gcv.line_width) XChangeGC(xw->display, xw->gc, (unsigned long) GCLineWidth, &xw->gcv); return NULL; } /*....................................................................... * Trim a coordinate to lie within the current pixmap and window area. * This prevents the cursor being displayed or returned for a position * outside the currently visible window and pixmap areas. * * Input: * xp XPoint * The point to be limited. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_bound_cursor(XWdev *xw, XPoint *xp) #else static int xw_bound_cursor(xw, xp) XWdev *xw; XPoint *xp; #endif { XWindowAttributes attr; /* Current window attributes */ int xmax, ymax; /* Max usable X and Y coordinates */ /* * Device error? */ if(xw->bad_device) return 1; /* * Get the current window dimensions. */ XGetWindowAttributes(xw->display, xw->window, &attr); if(xw->bad_device) return 1; /* * With NorthWest pixmap gravity, coordinates 0,0 are always visible at the * top left corner of the plot. */ if(xp->x < 0) xp->x = 0; if(xp->y < 0) xp->y = 0; /* * Determine the max X and Y coordinates that fall both within the pixmap and * the window. */ xmax = ((xw->geom.width < attr.width) ? xw->geom.width : attr.width) - 1; ymax = ((xw->geom.height < attr.height) ? xw->geom.height : attr.height) - 1; /* * Limit the coordinates to the above range. */ if(xp->x > xmax) xp->x = xmax; if(xp->y > ymax) xp->y = ymax; return 0; } /*....................................................................... * Draw the current cursor. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * bc Band * A cursor descriptor returned by xw_new_band(). * end XPoint * The current cursor position. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_draw_cursor(XWdev *xw, Band *bc, XPoint *end) #else static int xw_draw_cursor(xw, bc, end) XWdev *xw; Band *bc; XPoint *end; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Store the new end point. */ bc->end = *end; /* * Draw the cursor. */ switch(bc->mode) { case 0: default: if(xw->gc!=NULL && xw->crosshair) { XDrawLine(xw->display, xw->window, xw->gc, 0, bc->end.y, (int)xw->geom.width-1, bc->end.y); if(xw->bad_device) return 1; XDrawLine(xw->display, xw->window, xw->gc, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1); }; break; case 1: XDrawLine(xw->display, xw->window, xw->gc, bc->ref.x, bc->ref.y, bc->end.x, bc->end.y); break; case 2: /* Draw a rectangle */ { int x = bc->ref.x < bc->end.x ? bc->ref.x : bc->end.x; int y = bc->ref.y < bc->end.y ? bc->ref.y : bc->end.y; unsigned int width = (unsigned int) abs(bc->ref.x - bc->end.x); unsigned int height = (unsigned int) abs(bc->ref.y - bc->end.y); XDrawRectangle(xw->display, xw->window, xw->gc, x, y, width, height); }; break; case 3: /* Two horizontal lines */ XDrawLine(xw->display, xw->window, xw->gc, 0, bc->end.y, (int)xw->geom.width-1, bc->end.y); if(xw->bad_device) return 1; XDrawLine(xw->display, xw->window, xw->gc, 0, bc->ref.y, (int)xw->geom.width-1, bc->ref.y); break; case 4: /* Two vertical lines */ XDrawLine(xw->display, xw->window, xw->gc, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1); if(xw->bad_device) return 1; XDrawLine(xw->display, xw->window, xw->gc, bc->ref.x, 0, bc->ref.x, (int)xw->geom.height-1); break; case 5: /* One horizontal line through the cursor */ XDrawLine(xw->display, xw->window, xw->gc, 0, bc->end.y, (int)xw->geom.width-1, bc->end.y); break; case 6: /* One vertical line through the cursor */ XDrawLine(xw->display, xw->window, xw->gc, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1); break; case 7: /* Cross hair */ XDrawLine(xw->display, xw->window, xw->gc, 0, bc->end.y, (int)xw->geom.width-1, bc->end.y); if(xw->bad_device) return 1; XDrawLine(xw->display, xw->window, xw->gc, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1); break; }; if(xw->bad_device) return 1; XFlush(xw->display); if(xw->bad_device) return 1; return 0; } /*....................................................................... * Erase a previously drawn cursor. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * bc Band * A cursor descriptor returned by xw_new_band(). * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_erase_cursor(XWdev *xw, Band *bc) #else static int xw_erase_cursor(xw, bc) XWdev *xw; Band *bc; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Erase the cursor. */ switch(bc->mode) { case 0: default: if(xw->crosshair) { if(xw_cursor_line(xw, 0, bc->end.y, (int)xw->geom.width-1,bc->end.y) || xw_cursor_line(xw, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1)) return 1; }; break; case 1: /* Line cursor */ if(xw_cursor_line(xw, bc->ref.x, bc->ref.y, bc->end.x, bc->end.y)) return 1; break; case 2: /* Rectangle cursor */ if(xw_cursor_line(xw, bc->ref.x, bc->ref.y, bc->ref.x, bc->end.y) || xw_cursor_line(xw, bc->ref.x, bc->end.y, bc->end.x, bc->end.y) || xw_cursor_line(xw, bc->end.x, bc->end.y, bc->end.x, bc->ref.y) || xw_cursor_line(xw, bc->end.x, bc->ref.y, bc->ref.x, bc->ref.y)) return 1; break; case 3: /* Two horizontal lines */ if(xw_cursor_line(xw, 0, bc->end.y, (int)xw->geom.width-1,bc->end.y) || xw_cursor_line(xw, 0, bc->ref.y, (int)xw->geom.width-1,bc->ref.y)) return 1; break; case 4: /* Two vertical lines */ if(xw_cursor_line(xw, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1) || xw_cursor_line(xw, bc->ref.x, 0, bc->ref.x, (int)xw->geom.height-1)) return 1; break; case 5: /* One horizontal line through the cursor */ if(xw_cursor_line(xw, 0, bc->end.y, (int)xw->geom.width-1,bc->end.y)) return 1; break; case 6: /* One vertical line through the cursor */ if(xw_cursor_line(xw, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1)) return 1; break; case 7: /* Cross hair */ if(xw_cursor_line(xw, 0, bc->end.y, (int)xw->geom.width-1,bc->end.y) || xw_cursor_line(xw, bc->end.x, 0, bc->end.x, (int)xw->geom.height-1)) return 1; break; }; return 0; } /*....................................................................... * Restore the pixels under a given line. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * xa, ya int The start pixel of the line. * xb, yb int The end pixel of the line. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_cursor_line(XWdev *xw, int xa, int ya, int xb, int yb) #else static int xw_cursor_line(xw, xa, ya, xb, yb) XWdev *xw; int xa; int ya; int xb; int yb; #endif { int xlen = xb - xa; /* X-axis displacement of line */ int ylen = yb - ya; /* Y-axis displacement of line */ int xmin,xmax; /* Min/max X-axis end points */ int ymin,ymax; /* Min/max Y-axis end points */ #define PIXINC 51 /* * Device error? */ if(xw->bad_device) return 1; /* * Silently ignore the call if a pixmap is not available. */ if(xw->pixmap != None) { /* * Get sorted versions of xa and xb. */ if(xlen > 0) { xmin = xa; xmax = xb; } else { xmin = xb; xmax = xa; }; /* * Get sorted versions of ya and yb. */ if(ylen > 0) { ymin = ya; ymax = yb; } else { ymin = yb; ymax = ya; }; /* * Vertical line? */ if(xlen==0) { XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, xmin, ymin, (unsigned) 1, (unsigned) (ymax-ymin+1), xmin, ymin); } /* * Horizontal line? */ else if(ylen==0) { XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, xmin, ymin, (unsigned) (xmax-xmin+1), (unsigned) 1, xmin, ymin); } /* * Diagonal line encompasing fewer x-axis lines that y-axis lines? */ else if(abs(xlen) <= abs(ylen)) { int x; /* The X coordinate of the line of pixels being drawn */ int y1,y2; /* The start and end Y coordinates of the pixel line */ double yperx = (double) ylen / (double) xlen; double yhalf = 0.5 * yperx; /* Y-step over half a pixel */ double ydelt = (PIXINC+0.5) * yperx; /* Y-step over PIXINC+0.5 pixels */ double ylo = yperx > 0 ? yhalf : -ydelt; double yhi = yperx > 0 ? ydelt : -yhalf; /* * Draw the block of pixels that encompases the line between X-axis * pixels the outer edges of pixels x -> x+PIXINC, for each consecutive * block of PIXINC pixels along X. */ for(x=xmin; x <= xmax; x += PIXINC+1) { double ycent = ya + (x - xa) * yperx; y1 = (int)(ycent - ylo); /* Note round-down semantics */ y2 = (int)(ycent + yhi+0.5);/* Note round-up semantics */ XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, x, y1, (unsigned) (PIXINC+1), (unsigned) (y2-y1+1), x, y1); }; /* * Diagonal line encompasing fewer y-axis lines that x-axis lines? */ } else { int y; /* The Y coordinate of the line of pixels being drawn */ int x1,x2; /* The start and end X coordinates of the pixel line */ double xpery = (double) xlen / (double) ylen; double xhalf = 0.5 * xpery; /* X-step over half a pixel */ double xdelt = (PIXINC+0.5) * xpery; /* X-step over PIXINC+0.5 pixels */ double xlo = xpery > 0 ? xhalf : -xdelt; double xhi = xpery > 0 ? xdelt : -xhalf; /* * Draw the block of pixels that encompases the line between Y-axis * pixels the outer edges of pixels y -> y+PIXINC, for each consecutive * block of PIXINC pixels along Y. */ for(y=ymin; y <= ymax; y += PIXINC+1) { double xcent = xa + (y - ya) * xpery; x1 = (int)(xcent - xlo); /* Note round-down semantics */ x2 = (int)(xcent + xhi+0.5);/* Note round-up semantics */ XCopyArea(xw->display, xw->pixmap, xw->window, xw->gc, x1, y, (unsigned) (x2-x1+1), (unsigned) (PIXINC+1), x1, y); }; }; }; /* * Check for device errors. */ if(xw->bad_device) return 1; return 0; } /*....................................................................... * Add to the set of events to be caught. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * events long The bit mask of events to be added to those already * being selected. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_add_events(XWdev *xw, long events) #else static int xw_add_events(xw, events) XWdev *xw; long events; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Get the union of the new events with the current event mask. */ xw->event.mask |= events; /* * Register the modified selection with the server. */ XSync(xw->display, False); if(xw->bad_device) return 1; xw->last_error = 0; XSelectInput(xw->display, xw->window, xw->event.mask); if(xw->bad_device) return 1; /* * Force the new selections through to the server and check for access * errors that indicate that ButtonPress's are currently selected by * another client. */ XSync(xw->display, False); if(xw->bad_device) return 1; if(xw->last_error == BadAccess) { /* * Only one client can select ButtonPress events. If another client * already has them selected, then the above XSelectInputs() will have * generated an error and the event mask will not have been installed. */ if(xw->event.mask & ButtonPressMask) { if(!xw->event.no_buttons) { fprintf(stderr, "%s: Failed to acquire pointer buttons - use keys A,D,X.\n", XW_IDENT); }; xw->event.no_buttons = 1; }; /* * Retry, but with the events that could have caused the BadAccess removed. */ xw->event.mask &= ~(SubstructureRedirectMask | ResizeRedirectMask | ButtonPressMask); XSelectInput(xw->display, xw->window, xw->event.mask); if(xw->bad_device) return 1; XSync(xw->display, False); if(xw->bad_device) return 1; }; /* * Have we successfully acquired ButtonPress events? */ if(xw->event.mask & ButtonPressMask) xw->event.no_buttons = 0; return 0; } /*....................................................................... * Remove selected events from the set of events to be caught. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * events long The bit mask of events to be removed from the set * being selected. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_rem_events(XWdev *xw, long events) #else static int xw_rem_events(xw, events) XWdev *xw; long events; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Clear the bits in our current event mask that correspond to the events * to be removed. */ xw->event.mask &= ~events; /* * Register the modified selection with the server. */ XSelectInput(xw->display, xw->window, xw->event.mask); if(xw->bad_device) return 1; XSync(xw->display, False); if(xw->bad_device) return 1; return 0; } /*....................................................................... * This function is called by X whenever a non-fatal error occurs * on a given display connection. * * Input: * display Display * The display connection on which the error occured. * event XErrorEvent * The descriptor of the error event. * Output: * return int The return value is not specified by Xlib, so * we will simply return 0. */ #ifdef __STDC__ static int xw_error(Display *display, XErrorEvent *event) #else static int xw_error(display, event) Display *display; XErrorEvent *event; #endif { char errtxt[81]; /* Buffer to receive error message in */ XWdev *xw; /* * Find the device that is the source of the error. */ for(xw=device_list; xw!=NULL && xw->display!=display; xw = xw->next); /* * If a device was located, check if the error implies that server resources * have become unusable for that device. */ if(xw && !xw->bad_device) { xw->last_error = event->error_code; switch(event->error_code) { case BadAtom: case BadColor: case BadCursor: case BadDrawable: case BadGC: case BadIDChoice: case BadPixmap: case BadWindow: /* * Get a message describing the error. */ XGetErrorText(display, (int)event->error_code,errtxt,(int)sizeof(errtxt)); fprintf(stderr, "%s: XErrorEvent: %s\n", XW_IDENT, errtxt); /* * Report the operation that caused it. These opcode numbers are listed in * . */ fprintf(stderr, "%s: Major opcode of failed request: %d\n", XW_IDENT, (int) event->request_code); /* * Report the loss of the window and mark the device as unusable. */ xw_bad_device(xw); break; }; }; return 0; } /*....................................................................... * If a PGPLOT /xw server has not already been started, start one. * Return the ID of the server communication window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Output: * return Window The XID of the server communication window, or None * on error. */ #ifdef __STDC__ static Window xw_get_server(XWdev *xw) #else static Window xw_get_server(xw) XWdev *xw; #endif { int i; /* * See if a server has already been started. */ xw->server = XGetSelectionOwner(xw->display, xw->server_atom); /* * Start a new server if necessary. */ if(xw->server == None) { char *exe=NULL; /* The name of the pgxwin_server executable */ char *command=NULL; /* The command-line string used to run it */ char *display_string; /* The display-name string */ unsigned long slen; /* Length of command line excluding '\0' */ int waserr = 0; /* Set to true if an error occurs */ /* * Describe the format of the command line. */ #ifdef VMS char *format = "%s -display %s"; #else char *format = "%s -display %s display); /* * Locate the server program. */ #ifdef VMS if((exe=find_exe("PGPLOT_DIR", PGXWIN_SERVER))==NULL) { fprintf(stderr,"%s: Failed to find \"pgplot_dir:%s.exe\".\n", XW_IDENT, PGXWIN_SERVER); return None; }; #else if((exe=find_exe(getenv("PGPLOT_DIR"), PGXWIN_SERVER))==NULL && (exe=find_exe(getenv("PATH"), PGXWIN_SERVER))==NULL) { fprintf(stderr, "%s: Couldn't find program \"%s\" in the directory named\n", XW_IDENT, PGXWIN_SERVER); fprintf(stderr, "%s: in your PGPLOT_DIR environment variable, or in any directory\n", XW_IDENT); fprintf(stderr, "%s: listed in your PATH environment variable.\n",XW_IDENT); return None; }; #endif /* * Make it possible to determine which server is being started. */ if(getenv("PGPLOT_XW_DEBUG")) printf("Starting %s.\n", exe); /* * Determine the length of the comand-line string required, as defined by: * sprintf(command, format, PGXWIN_SERVER, display_string) */ slen = strlen(format) + strlen(exe) + strlen(display_string); command = (char *) malloc(sizeof(char) * (slen + 1)); if(command==NULL) { fprintf(stderr, "%s: Insufficient memory to run %s.\n", XW_IDENT, exe); waserr = 1; } else { /* * Compile the command-line string. */ sprintf(command, format, exe, display_string); /* * Spawn the server. */ #ifdef VMS waserr = vms_spawn_nowait(command); #else /* * Stipulate that the existing socket connection to the server be closed * on the following exec(). This prevents the child from holding the * connection open when the parent terminates. */ fcntl(ConnectionNumber(xw->display), F_SETFD, 1); /* * Run the server. */ system(command); #endif }; /* * Release the malloc'd command line string. */ if(command) free(command); /* * Check once per second for up to XW_SERVER_TIMEOUT seconds for the * server to start. */ if(!waserr) { for(i=0; xw->server==None && iserver = XGetSelectionOwner(xw->display, xw->server_atom); }; /* * Contact with server not acheived? */ if(xw->server == None) { fprintf(stderr, "%s: Timed out waiting for program %s to start\n", XW_IDENT, exe); }; }; /* * Discard the string that contained the name of the server executable. */ if(exe) free(exe); }; return xw->server; } /*....................................................................... * Send a ClientMessage query to the server and read its reply. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Input/Output: * event XEvent * The input ClientMessage event. * On input set: * event.xclient.message_type = Type of message. * event.xclient.data.l[0..4] = Message data. * On output: * event.xclient.data.l[0..4] = Reply data. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_query_server(XWdev *xw, XEvent *event) #else static int xw_query_server(xw, event) XWdev *xw; XEvent *event; #endif { /* * Device error? */ if(xw->bad_device) return 1; /* * Initialize the generic parts of the event descriptor. */ event->type = ClientMessage; event->xclient.window = xw->client; event->xclient.format = 32; if(!XSendEvent(xw->display, xw->server, False, (long)0, event) || xw->bad_device) { fprintf(stderr, "%s: Error talking to PGPLOT /xw server.\n", XW_IDENT); return 1; }; XFlush(xw->display); if(xw->bad_device) return 1; /* * Read the server's reply. */ do { if(xw_next_event(xw, event)) return 1; } while(event->type != ClientMessage || event->xclient.window != xw->client); /* * A returned message type of None denotes an error. */ if(event->xclient.message_type == None) return 1; return 0; } /*....................................................................... * Front end to XNextEvent() to get the next event from the X server, * while checking for DestroyNotify events on the PGPLOT window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * Input/Output: * event XEvent * The event structure for the returned event. * Output: * return int 0 - OK. * 1 - The PGPLOT window has been destroyed. */ #ifdef __STDC__ static int xw_next_event(XWdev *xw, XEvent *event) #else static int xw_next_event(xw, event) XWdev *xw; XEvent *event; #endif { /* * Check that we still have a window. */ if(xw->bad_device) return 1; /* * Wait for the next event. */ XNextEvent(xw->display, event); switch(event->type) { case DestroyNotify: if(event->xdestroywindow.window == xw->window) return xw_bad_device(xw); }; return 0; } /*....................................................................... * Front end to XCheckWindowEvent() to check and return for the next event * that matches the given event_mask, without blocking if no matching event * is there and while also checking for DestroyNotify events on said window. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * window Window The window on which to watch for events. * event_mask long The bit mask of event types wanted. * Input/Output: * event XEvent * The event structure for the returned event. * Output: * return int 0 - No matching event. * 1 - Got an event that matches the mask. */ #ifdef __STDC__ static int xw_check_window_event(XWdev *xw, Window window, long event_mask, XEvent *event) #else static int xw_check_window_event(xw, window, event_mask, event) XWdev *xw; Window window; long event_mask; XEvent *event; #endif { int want_structure = 0; /* True if the caller selects StructureNotifyMask */ /* * Check that we still have a window. */ if(xw->bad_device) return 1; /* * Did the user also want StructureNotifyMask events? */ want_structure = event_mask & StructureNotifyMask; /* * We also want DestroyNotify events. */ event_mask |= StructureNotifyMask; /* * Wait for the next event. */ while(XCheckWindowEvent(xw->display, window, event_mask, event)==True) { switch(event->type) { case DestroyNotify: if(window == xw->window) { /* Have we lost the plot window? */ xw_bad_device(xw); return want_structure; } else if(want_structure) { return 1; }; break; case CirculateNotify: case ConfigureNotify: if(want_structure) /* Ignore unselected StructureNotifyMask events */ return 1; break; default: return 1; /* One of the requested events was found */ }; }; return 0; } /*....................................................................... * Insert a new PGPLOT /xw device descriptor onto the list of open * devices. The descriptor is inserted such that the list is maintained * in order of window number xw->number. * * Input: * xw XWdev * The PGPLOT /xw device descriptor to be inserted. * Output: * return XWdev * The same as the input. */ #ifdef __STDC__ static XWdev *xw_insert_device(XWdev *xw) #else static XWdev *xw_insert_device(xw) XWdev *xw; #endif { XWdev *prev; /* Pointer to previous device in list */ XWdev *next; /* Pointer to next device in list */ /* * Find the correct position for the device in the device list. */ prev = NULL; next = device_list; while(next && next->number > xw->number) { prev = next; next = next->next; }; /* * Insert the device between 'prev' and 'next'. */ xw->next = next; if(prev==NULL) device_list = xw; else prev->next = xw; return xw; } /*....................................................................... * Remove a given PGPLOT /xw device descriptor from the list of open * devices. * * Input: * xw XWdev * The PGPLOT /xw device descriptor to be removed. * Output: * return XWdev * The removed descriptor. */ #ifdef __STDC__ static XWdev *xw_remove_device(XWdev *xw) #else static XWdev *xw_remove_device(xw) XWdev *xw; #endif { XWdev *prev; /* Pointer to previous device in list */ XWdev *next; /* Pointer to next device in list */ /* * Find the position of the device in the device list. */ prev = NULL; next = device_list; while(next && next!=xw) { prev = next; next = next->next; }; /* * Relink around the window if it was found. */ if(next) { if(prev==NULL) device_list = next->next; else prev->next = next->next; }; /* * The descriptor is no longer in a list. */ xw->next = NULL; return xw; } /*....................................................................... * Select a given device by its PGPLOT window number: xw->number. * * Input: * number int The device number to search for. * Output: * return XWdev * The descriptor of the located device, or NULL * on error. */ #ifdef __STDC__ static XWdev *xw_select_device(int number) #else static XWdev *xw_select_device(number) int number; #endif { /* * Search for the cited device. */ XWdev *xw = device_list; while(xw && xw->number != number) xw = xw->next; if(xw==NULL || xw->number!=number) { fprintf(stderr, "%s: No such device (%d).\n", XW_IDENT, number); return NULL; }; return xw; } /*....................................................................... * Wait for data to become available on the xw->client_data property * and read it into the given buffer, after performing any necessary * data-type conversions between different sized integers. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * data char * The buffer to return the data in, cast to (char *). * form int The format for the property. Recognised values and * the data types used to accept them in data[] are: * XW_CHAR_PROP - (char) * XW_SHORT_PROP - (short) * XW_LONG_PROP - (long) * n unsigned long The number of items to be returned in data[]. * Output: * return unsigned long The number of items read, or 0 on error. */ #ifdef __STDC__ static unsigned long xw_get_data(XWdev *xw, char *data, int form, unsigned long n) #else static unsigned long xw_get_data(xw, data, form, n) XWdev *xw; char *data; int form; unsigned long n; #endif { XEvent event; /* Used to check for property-notify events */ unsigned long ndone; /* The number of items read so far */ unsigned long nread; /* The number of items read in the latest iteration */ Atom ret_type; /* Returned data-type */ int ret_form; /* Returned data-format */ unsigned long nret; /* Number of elements returned */ unsigned long nleft; /* Number of bytes unread */ unsigned char *prop; /* Property value */ unsigned long size; /* Size of property data element */ /* * Device error? */ if(xw->bad_device) return 0; /* * The property data returned by XGetWindowProperty is arranged as an array of * (char) if form=8, (short) if form=16, and (long) if form=32, * irrespective of the sizes of these types. Get the size of one such * element in bytes. */ switch(form) { case XW_CHAR_PROP: size = sizeof(char); break; case XW_SHORT_PROP: size = sizeof(short); break; case XW_LONG_PROP: size = sizeof(long); break; default: fprintf(stderr, "%s: Unkown property format: %d\n", XW_IDENT, form); xw_bad_device(xw); return 0; break; }; /* * The property data may not appear in one go, so it may take a * few iterations to get all the data. The server signals completion * by sending a 0-length property. */ ndone = nread = 0; do { /* * Wait for the property to be updated. */ do { if(xw_next_event(xw, &event)) return 0; } while(!(event.type == PropertyNotify && event.xproperty.window == xw->client && event.xproperty.atom == xw->client_data && event.xproperty.state == PropertyNewValue)); /* * Determine the format of the data stored in the property but defer * reading the data, by asking for 0 items. */ if(XGetWindowProperty(xw->display, xw->client, xw->client_data, (long)0, (long)0, False, AnyPropertyType, &ret_type, &ret_form, &nret, &nleft, &prop) != Success) { fprintf(stderr, "%s: Error reading property.\n", XW_IDENT); xw_bad_device(xw); return 0; } else { /* * Delete the copied 0-length (+1 byte Xlib added padding) property value. */ XFree((char *) prop); /* * Make sure that the property has the expected type. */ if(ret_form != form) { fprintf(stderr, "%s: Inconsistent property format.\n", XW_IDENT); xw_bad_device(xw); return 0; }; /* * Since XGetWindowProperty requires one to specify the amount to be * read in multiples of 4 8-bit bytes, round-up 'nleft' to the nearest * 4-byte multiple >= nleft. */ nleft = 4 * ((nleft+3)/4); if(nleft > 0) { /* * Read the property value. */ if(XGetWindowProperty(xw->display, xw->client, xw->client_data, (long)0, (long)nleft/4, False, ret_type, &ret_type, &ret_form, &nread, &nleft, &prop) != Success) { fprintf(stderr, "%s: Error reading property.\n", XW_IDENT); xw_bad_device(xw); return 0; } else { /* * Accumulate up to n items in the output data array. */ if(ndone < n) { unsigned long ncopy = (ndone+nread<=n) ? nread : (n-ndone); unsigned long icopy; for(icopy=0; icopy < ncopy*size; icopy++) data[ndone*size+icopy] = ((char *)prop)[icopy]; ndone += ncopy; }; /* * Delete the property data buffer. */ XFree((char *)prop); }; } else { nread = 0; /* 0-length property detected. */ }; /* * Delete the property, both to release resources and to signal completion * to the server. */ XDeleteProperty(xw->display, xw->client, xw->client_data); }; /* * The server signals that there is no more data to be read by sending * a zero-length property. Don't stop reading until this has been * detected, even if all expected data have been read. */ } while(nread>0); /* * Nothing read? */ if(n!=0 && ndone==0) { fprintf(stderr, "%s: Failed to read property data.\n", XW_IDENT); del_XWdev(xw,1); }; return ndone; } /*....................................................................... * After a fatal error has occured, this function should be called to * mark the specified device as unusable. It emits an error message * and sets xw->bad_device=1. * * Input: * xw XWdev * The descriptor of the device on which the error * occurred. * Output: * xw->bad_device This flag is set to 1. * return int Allways 1 (intended as a boolean to say that the * device is unusable). This can be used as the return * value for functions that use 1 to denote an error * return. eg. * if(error_occurred) * return xw_bad_device(xw); */ #ifdef __STDC__ static int xw_bad_device(XWdev *xw) #else static int xw_bad_device(xw) XWdev *xw; #endif { /* * Only report an error if this is the first time that this function * has been called on this device. */ if(xw && !xw->bad_device) { fprintf(stderr, "%s: Lost PGPLOT window %d.\n", XW_IDENT, xw->number); xw->bad_device = 1; }; return 1; } /*....................................................................... * If the cursor is within the plot window, warp it to a given position. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * pos XPoint * The location to warp the pointer to if 'warp' is true * and the cursor is in the window. * warp int If true, and the cursor is in the window, warp the * cursor to position 'pos'. * Output: * loc XPoint * The located position of the cursor, if it is in * the window. * return int 0 - Cursor not in window - 'loc' is unchanged. * 1 - Cursor is in window - 'loc' records the position. */ #ifdef __STDC__ static int xw_locate_cursor(XWdev *xw, XPoint *pos, int warp, XPoint *loc) #else static int xw_locate_cursor(xw, pos, warp, loc) XWdev *xw; XPoint *pos; int warp; XPoint *loc; #endif { XWindowAttributes attr; /* Current window attributes */ Window p_child; /* The child of /xw (None) containing the pointer */ int p_win_x, p_win_y; /* The pointer coordinates in xw->window */ int p_root_x, p_root_y; /* The pointer coordinates in the root window */ Window p_root_win; /* The root window containing the cursor */ unsigned int p_mask; /* Bit mask of button states etc.. */ int inwindow=0; /* True if the cursor is in the window */ /* * Device error? */ if(xw->bad_device) return 0; /* * Query the current state of the window. */ XSync(xw->display, False); if(xw->bad_device) return 0; XGetWindowAttributes(xw->display, xw->window, &attr); if(xw->bad_device) return 0; /* * Determine the current position of the pointer. */ XQueryPointer(xw->display, xw->window, &p_root_win, &p_child, &p_root_x, &p_root_y, &p_win_x, &p_win_y, &p_mask); if(xw->bad_device) return 0; /* * Is the cursor within the bounds of the window? */ inwindow = ((attr.map_state != IsUnmapped) && (p_win_x >= 0 && p_win_x < attr.width) && (p_win_y >= 0 && p_win_y < attr.height)); if(inwindow) { /* * Warp the cursor? */ if(warp) { XWarpPointer(xw->display, None, xw->window, 0, 0, 0, 0, pos->x, pos->y); if(xw->bad_device) return 0; loc->x = pos->x; loc->y = pos->y; /* * Return the current position of the cursor without warping. */ } else { loc->x = p_win_x; loc->y = p_win_y; }; }; return inwindow; } #ifdef VMS /*....................................................................... * Define a given executable as a DCL foreign command. This has to be * done before the program can be run with command-line arguments. * * Input: * file char * The full file name of the executable. * command char * The name to give the command that invokes 'file'. * Output: * return int 0 - OK. * 1 - Error. */ static int vms_define_command(char *file, char *command) { VMS_string value_dsc; /* Foreign command string */ VMS_string symbol_dsc; /* Symbol name for foreign command */ long table = LIB$K_CLI_LOCAL_SYM; /* Table to add symbol to */ char *value = NULL; /* Dynamically allocated symbol value string */ int waserr = 0; /* True after error */ /* * Compose a VMS symbol value to use to define 'command' as a foreign * command that takes C-style arguments. */ if((value = (char *) malloc(1+strlen(file)+1))==NULL) { fprintf(stderr, "%s: Insufficient memory to define command for: %s.\n", XW_IDENT, file); waserr = 1; } else { sprintf(value, "$%s", file); VMS_STRING(value_dsc, value) VMS_STRING(symbol_dsc, command) /* * Register the symbol value to symbol 'command'. */ lib$set_symbol(&symbol_dsc, &value_dsc, &table); }; /* * Release resources. */ if(value) free((char *)value); return waserr != 0; } /*....................................................................... * Run a PGPLOT program on a VAX VMS machine in the background, with * sys$input redirected from NL: so that the child process does not * get sent its parent's signals. * Unfortunately system() can't be used. For some unknown reason * system("spawn/nowait/sys$input=nl: command_line") * doesn't appear to do anything. It doesn't even produce an error * message to say why. If the nowait qualifier is removed it works fine, * but that is not what is wanted. * * Input: * command char * The command line. * Output: * return int 0 - No error detected. * 1 - Definate error detected. */ static int vms_spawn_nowait(char *command) { VMS_string comm_dsc; /* VMS string descriptor for 'command'. */ VMS_string sysinp; /* VMS string descriptor of SYS$INPUT string */ long flags = CLI$M_NOKEYPAD | CLI$M_NOWAIT; /* * Construct VMS descriptors of C strings. */ VMS_STRING(comm_dsc, command) VMS_STRING(sysinp, "NL:") if(lib$spawn(&comm_dsc,&sysinp,0,&flags,0,0,0,0,0,0,0) != SS$_NORMAL) { fprintf(stderr, "%s: Unable to execute command line: %s\n", XW_IDENT, command); return 1; }; return 0; } #endif /*....................................................................... * Locate an executable by searching for it in a list of directories. * The list of directories is a string containing directory paths * separated by ':'s (',' under VMS). If the first or last character * in the path is one of these terminators, or if two of these terminators * are adjacent in the path, then the current directory is included in * the search. Each directory in the path is searched in order and the * first match is returned. * * Note that these semantics are identical to the UNIX Bourne-shell * treatment of the PATH environment variable. * * In order that getenv() can be used directly as an argument to this * function without invoking error messages when getenv() returns * NULL, either or both of the 'path' and 'program' arguments can be * NULL. In this case find_exe() quietly returns NULL as though it had * searched for the executable and failed to find it. * * Input: * program char * The name of the program to be located. * In the case of this being NULL, find_exe() will * quietly abort and return NULL. This allows one * to use getenv() without worrying about the NULL * return case. * path char * A colon-separated (comma-separated under VMS), * '\0' terminated list of directory paths to search * for the program in. * Output: * return char * The full name of the executable, or NULL if not * found. The returned pointer is malloc()d * memory and should be free()d by the caller when * no longer required. */ #ifdef __STDC__ static char *find_exe(char *path, char *program) #else static char *find_exe(path, program) char *path; char *program; #endif { char *dir; /* Pointer to start of directory in 'path' */ char *buf=NULL; /* A buffer used to compile file names in */ int buflen=0; /* The size of the dynamic buffer in char's */ int prog_len; /* Length of program name */ int dirlen; /* Length of directory name pointed to by 'dir' */ int path_len; /* Length of latest path name */ #ifdef VMS char *exe = ".exe";/* VMS executable extension */ char *sep = ""; /* VMS directory/file separator (overriden below) */ int term = ','; /* Directory separator in path (in addition to '\0') */ #else char *exe = ""; /* UNIX doesn't add extensions */ char *sep = "/"; /* UNIX directory/file separator */ int term = ':'; /* Directory separator in path (in addition to '\0') */ #endif /* * No path or executable? */ if(path==NULL || program==NULL) return NULL; /* * Allocate memory for the filename buffer. */ buflen = strlen(program) + 40; buf = (char *) malloc(sizeof(char) * (buflen+1)); if(buf==NULL) { fprintf(stderr, "%s: Insufficient memory to locate program: %s\n", XW_IDENT, program); return buf; }; /* * Determine the length of the program name. */ prog_len = strlen(program); /* * Seek the program in each 'term' separated path name. */ do { /* * Maintain a pointer to the start of the directory path. */ dir = path; /* * Find the directory terminator. */ while(*path && *path != term) path++; /* * Record the path length. */ dirlen = path - dir; /* * Skip the trailing terminator unless at the end of the path. */ if(*path) path++; /* * Under VMS a separator is not required if the directory is given * explicitly rather than with logical variables. */ #ifdef VMS sep = dirlen>0 && dir[dirlen-1]==']' ? "" : ":"; #endif /* * Combine the directory and command file name into a full program * name. */ path_len = dirlen + strlen(sep) + prog_len + strlen(exe) ; if(path_len > buflen) { char *new_buf = realloc(buf, (path_len+1) * sizeof(char)); if(new_buf==NULL) { fprintf(stderr, "%s: Insufficient memory to locate program: %s\n", XW_IDENT, program); free(buf); return buf; }; buf = new_buf; }; sprintf(buf, "%.*s%s%s%s", dirlen, dir, dirlen==0 ? "":sep, program, exe); /* * See if the executable file exists. */ #ifndef X_OK #define X_OK 1 #endif #ifndef R_OK #define R_OK 4 #endif #ifdef VMS if(access(buf, X_OK)==0 || access(buf, R_OK)==0) { if(vms_define_command(buf, program)) /* Define a foreign VMS command */ break; strcpy(buf, program); return buf; }; #else if(access(buf, X_OK)==0) return buf; #endif } while(*path); /* * Executable file not found. */ free(buf); return NULL; } /*....................................................................... * Return a dynamically allocated visual info structure for a given * visual. This is simply a more convenient interface to XGetVisualInfo() * and XVisualIDFromVisual(). * * Input: * display Display * The display connection to which the visual * belongs. * screen int The screen to which the visual belongs. * visual Visual * The visual for which information is required. * Output: * return XVisualInfo * The required information descriptor, or NULL * on error. */ #ifdef __STDC__ static XVisualInfo *xw_visual_info(Display *display, int screen, Visual *visual) #else static XVisualInfo *xw_visual_info(display, screen, visual) Display *display; int screen; Visual *visual; #endif { XVisualInfo *vi=NULL; /* The return descriptor */ XVisualInfo template; /* The search template */ int nret = 0; /* The number of descriptors returned */ /* * Using the visual ID and the screen should unambiguously select the * information for the specified visual. */ template.visualid = XVisualIDFromVisual(visual); template.screen = screen; vi = XGetVisualInfo(display, (long)(VisualIDMask | VisualScreenMask), &template, &nret); if(vi == NULL || nret < 1) { fprintf(stderr, "%s: Error getting visual information for visual ID 0x%lx, screen %d.\n", XW_IDENT, (unsigned long)template.visualid, screen); vi = NULL; }; return vi; } /*....................................................................... * Allocate the contents of xw->image. This contains buffers used to * construct and dispatch line-of-pixel images to the display. * * Note that xw_get_visual() must have been called before this function. * * Input: * xw XWdev * The PGPLOT /xw device descriptor. * npix int The length of the buffer in pixels. * Output: * return int 0 - OK. * 1 - Error. */ #ifdef __STDC__ static int xw_get_image(XWdev *xw, int npix) #else static int xw_get_image(xw, npix) XWdev *xw; int npix; #endif { /* * Create the X image that we use to compose lines of pixels with given * colors. */ xw->image.xi = XCreateImage(xw->display, xw->color.vi->visual, (unsigned)xw->color.vi->depth, ZPixmap, 0, NULL, (unsigned)npix, 1, 32, 0); if(xw->image.xi==NULL) { fprintf(stderr, "%s: Failed to allocate XImage container.\n", XW_IDENT); return 1; }; /* * Allocate the image buffer. */ xw->image.xi->data = malloc((size_t) xw->image.xi->bytes_per_line); if(!xw->image.xi->data) { fprintf(stderr, "%s: Failed to allocate image buffer.\n", XW_IDENT); return 1; }; return 0; } /*....................................................................... * Limit pixmap coordinates to lie within the pixmap area. * * Input: * xw XWdev * The PGPLOT window context. * Input/Output: * coord XPoint * The coordinates to be modified. */ #ifdef __STDC__ static void xw_limit_pcoords(XWdev *xw, XPoint *coord) #else static void xw_limit_pcoords(xw, coord) XWdev *xw; XPoint *coord; #endif { if(xw->pixmap != None) { if(coord->x >= xw->geom.width) coord->x = xw->geom.width - 1; if(coord->y >= xw->geom.height) coord->y = xw->geom.height - 1; if(coord->x < 0) coord->x = 0; if(coord->y < 0) coord->y = 0; }; return; } /*....................................................................... * Return the nearest integer to a given floating point number. * * Input: * f float The floating point number to be rounded. * Output: * return int The nearest integer to f. */ #ifdef __STDC__ static int xw_nint(float f) #else static int xw_nint(f) float f; #endif { return (int) (f >= 0.0 ? (f + 0.5) : (f - 0.5)); } /*....................................................................... * Scroll a rectanglular area vertically and/or horizontally. * * Input: * xw XWdev * The PGPLOT window context. * rbuf float * The array of float arguments sent by the PGPLOT * GREXEC() subroutine. */ #ifdef __STDC__ static void xw_scroll_rect(XWdev *xw, float *rbuf) #else static void xw_scroll_rect(xw, rbuf) XWdev *xw; float *rbuf; #endif { if(!xw->bad_device && xw->pixmap != None) { XPoint blc, trc; /* The bottom left and top right rectangle corners */ XPoint blc_orig, trc_orig; /* The vertices of the rectangle to be copied */ XPoint blc_dest, trc_dest; /* The vertices of the destination of the copy */ int dx, dy; /* The amounts to scroll right and down */ unsigned long fg; /* The foreground color to be reinstated */ /* * Convert the rectangle vertices from PGPLOT coordinates to X coordinates. */ xw_xy_to_XPoint(xw, &rbuf[0], &blc); xw_xy_to_XPoint(xw, &rbuf[2], &trc); /* * Get the scroll offsets in X coordinates. */ dx = xw_nint(rbuf[4]); dy = xw_nint(-rbuf[5]); /* * Selected parts of the pixmap will need to be erased by drawing an * opaque rectangle over them in the background color. Set the foreground * color to equal the background. Keep a record of the previous foreground * color, so that it can be re-instated. */ fg = xw->gcv.foreground; XSetForeground(xw->display, xw->gc, xw->color.pixel[0]); /* * If either scroll extent exceeds the length of the associated * axis, then fill the area with the background color. */ if(abs(dx) > trc.x - blc.x || abs(dy) > blc.y - trc.y) { XFillRectangle(xw->display, xw->pixmap, xw->gc, blc.x, trc.y, (unsigned)(trc.x-blc.x+1), (unsigned)(blc.y-trc.y+1)); /* * Scroll within the rectangle by copying the area that is to be preserved * to a new location shifted appropriately in X and/or Y. Then clear the * vacated areas. */ } else { /* * Calculate the vertices of the source and destination rectangles to * be copied. */ blc_orig = blc_dest = blc; trc_orig = trc_dest = trc; if(dx > 0) { trc_orig.x = trc.x - dx; blc_dest.x = blc.x + dx; } else if(dx < 0) { blc_orig.x = blc.x - dx; trc_dest.x = trc.x + dx; }; if(dy > 0) { blc_orig.y = blc.y - dy; trc_dest.y = trc.y + dy; } else if(dy < 0) { trc_orig.y = trc.y - dy; blc_dest.y = blc.y + dy; }; /* * Constrain the coordinates to lie within the pixmap. */ xw_limit_pcoords(xw, &blc_orig); xw_limit_pcoords(xw, &blc_dest); xw_limit_pcoords(xw, &trc_orig); xw_limit_pcoords(xw, &trc_dest); /* * Scroll the rectangle to its shifted location. */ XCopyArea(xw->display, xw->pixmap, xw->pixmap, xw->gc, blc_orig.x, trc_orig.y, trc_orig.x - blc_orig.x + 1, blc_orig.y - trc_orig.y + 1, blc_dest.x, trc_dest.y); /* * Clear the vacated area to the left or right of the copied area. */ if(dx > 0) { XFillRectangle(xw->display, xw->pixmap, xw->gc, blc.x, trc.y, (unsigned) dx, (unsigned) (blc.y - trc.y + 1)); } else if(dx < 0) { XFillRectangle(xw->display, xw->pixmap, xw->gc, trc_dest.x, trc.y, (unsigned) (-dx), (unsigned) (blc.y - trc.y + 1)); }; /* * Clear the vacated area above or below the copied area. */ if(dy > 0) { XFillRectangle(xw->display, xw->pixmap, xw->gc, blc.x, trc.y, (unsigned) (trc.x - blc.x + 1), (unsigned) dy); } else if(dy < 0) { XFillRectangle(xw->display, xw->pixmap, xw->gc, blc.x, blc_dest.y, (unsigned) (trc.x - blc.x + 1), (unsigned) (-dy)); }; }; /* * Record the extent of the modified part of the pixmap. */ xw_mark_modified(xw, blc.x, blc.y, 1); xw_mark_modified(xw, trc.x, trc.y, 1); /* * Re-instate the original foreground color. */ XSetForeground(xw->display, xw->gc, fg); }; return; } /* VMS directory/file separator (overriden below) */ int term = ','; /* Directory separator in path (in addition to '\0') */ #else char *exe = ""; /* UNIX doesn't add extensions */ char *sep = "/"; /* UNIX directory/file separator */ int term = ':'; /* Directory separator in path (in addition to '\0') */ #endif /* * No path or executapgplot/drivers/hjdriv.f010064400040640000322000001317730641627225300156700ustar00tjpcitmbr00000400000017*HJDRIV -- PGPLOT Hewlett Packard [Desk/Laser] Jet driver C+ SUBROUTINE HJDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Hewlett Packard Desk/Laserjet device. C C Version 1.0 - 1989 Apr 09 - S. C. Allendorf C Combined all drivers into one driver that C uses a logical name to choose the format. C Version 1.1 - 1989 Sept - B. H. Toby C (1) adapt for PC version of PGPLOT C (2) use alternate logical name definitions C (3) support for DeskJet/ " Plus/ " 500 C (4) reduce page size to 10.25 to fix PGIDENT C C Version 1.2 - 1991 Aug - B. H. Toby C Clean up and add code for GRIFB1 since the C subroutine is not in GRPCKG as of PGPLOT V4.9d C C IBM PC / HP DeskJet printer usage C Default file name is LPT1 (parallel port#1) C Setup the port using MODE LPTn:,,P (parallel) C or MODE COMn:96,N,8,1,P (serial) C Use COMn/HJ or LPTn/HJ to send output directly to a device C or FILE.EXT/HJ or d:\path\file.ext/HJ to send the output C to a file C Files can be written to disk and then copied to the printer. C However, there is a problem in treating plot files, since they C may contain ^Z (end-of-file) and other control characters. Use C COPY file.ext /B LPT1: C to print the file. C Note that logical name PGPLOT_xx under VMS corresponds to MS-DOS C environment variable PG_xxx C Ported back to VAX/VMS, lines of code changed are indicated by a "C!" flag. C======================================================================= C C Supported device: Hewlett Packard LaserJet, LaserJet+, or LaserJet II. C DeskJet, DeskJet Plus, DeskJet 500 C C Device type code: /HJ C C Default device name: PGPLOT.HJPLT. C C Default view surface dimensions: Depends on which driver settings are C chosen, via logical names PGPLOT_HJ_MODE, PGPLOT_HJ_MAR, PGPLOT_HJ_SIZE C and PGPLOT_HJ_PAGE. C C Resolution: Depends on which driver settings are chosen, via C logical names PGPLOT_HJ_MODE or PGPLOT_HJ_RES. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. It is not possible to change color representation. C C Input capability: None. C C File format: See the LaserJet & DeskJet Printer Technical Reference Manuals C for details of the file format. C C Obtaining hardcopy: Use the command PRINT/PASSALL. C C Logical Name Usage: C ------- ---- ------ C C PGPLOT_HJ_MODE: use $ DEFINE PGPLOT_HJ_MODE HJnn C C where nn is a number 1 - NDEV inclusive. You may also use one of the C equivalent names listed below. C Thus $ DEFINE PGPLOT_HJ_MODE HJ01 C and $ DEFINE PGPLOT_HJ_MODE LHOR are equivalent (etc.) C The equivalent names are an attempt to make the driver names make C sense. They are decoded as follows: C C 1st character: P for protrait orientation or C L for landscape orientation. C 2nd character: H for high resolution (300 dpi) or C M for medium resolution (150 dpi) or C L for low resolution (100 dpi). C 3rd character: B for a straight bitmap dump (subroutine GRHJ01) or C O for an optimized bitmap dump (subroutine GRHJ02). C 4th character: R for a rectangular view surface or C S for a square view surface. C C A few notes are in order. First, not all of the possible combinations C above are supported (currently). The driver that goes by the name of C PHOT is a driver that puts out bitmaps suitable for inclusion in TeX C output if you are using the Arbortext DVIHP program. The only drivers C that will work with unexpanded LaserJet are HJ08 and HJ09. The other C seven drivers require a LaserJet Plus or LaserJet II. Finally, do NOT C attempt to send grayscale plots to the drivers that use the optimized C bitmap dumps. Terrible things will happen. C C Driver Equiv Size (H x V) Resolution C ------ ----- --------------------- ---------- C HJ01 LHOR 10.25 by 8.00 inches 300 DPI C HJ02 PHOR 8.00 by 10.25 inches 300 DPI C HJ03 PHOT 8.00 by 10.25 inches 300 DPI C HJ04 LHBR 6.54 by 4.91 inches 300 DPI C HJ05 PHBS 5.65 by 5.65 inches 300 DPI C HJ06 LMBR 10.25 by 8.00 inches 150 DPI C HJ07 PMBR 8.00 by 10.25 inches 150 DPI C HJ08 PMBS 4.48 by 4.48 inches 150 DPI C HJ09 PLBS 6.00 by 6.00 inches 100 DPI C C The following logical names will override the PGPLOT_HJ_MODE settings, C if used. C C PGPLOT_HJ_RES: use $ DEFINE PGPLOT_HJ_RES x where x is H, M, L or V C H or HIGH for 300 bpi C M or MEDIUM for 150 bpi C L or LOW for 100 bpi C V or VERYLOW for 75 bpi C C PGPLOT_HJ_MAR: use $ DEFINE PGPLOT_HJ_MAR "xx.xx,yy.yy" C where "xx.xx" and "yy.yy" are the vertical and horizontal C margin dimensions in inches. The number of characters, including C spaces preceeding and following the comma, should not exceed five. C $ DEFINE PGPLOT_HJ_MAR "1.0,1.0" is valid C $ DEFINE PGPLOT_HJ_MAR " 1.0 ,1.0" is valid C but $ DEFINE PGPLOT_HJ_MAR " 1.00 ,1.0" is not valid C C PGPLOT_HJ_SIZE: use $ DEFINE PGPLOT_HJ_SIZE "xx.xx,yy.yy" C where "xx.xx" and "yy.yy" are the vertical and horizontal C plot dimensions in inches. The number of characters, including C spaces preceeding and following the comma, should not exceed five. C $ DEFINE PGPLOT_HJ_SIZE "10.,8." is valid C $ DEFINE PGPLOT_HJ_SIZE "10.0 , 8.0 " is valid C but $ DEFINE PGPLOT_HJ_SIZE " 10.0 ,8.0" is not valid C C PGPLOT_HJ_TEX: use $ DEFINE PGPLOT_HJ_TEX T C if PGPLOT_HJ_TEX is defined with any value, TeX mode (see above) C will be used. C C PGPLOT_HJ_NOFF: use $ DEFINE PGPLOT_HJ_NOFF T C if PGPLOT_HJ_NOFF is defined with any value, the form feed C needed to eject the final page will be omitted. This is useful C for spooled printers -- it prevents wasted (blank) pages. C C PGPLOT_HJ_PAGE: use $ DEFINE PGPLOT_HJ_PAGE x where x is L or P C Use L (or LANDSCAPE) for Landscape mode C Use P (or PORTRAIT) for Portrait mode C C PGPLOT_HJ_OPT: use $ DEFINE PGPLOT_HJ_OPT x where x is O or C C Use O (or OPTIMIZE) so that bitmap will be "optimized" C Use C (or COMPRESS) so that bitmap will be "compressed" C C "Optimized" mode minimizes the memory usage for the LaserJet devices. C This sometimes leads to a larger file than if optimization is not C used. Optimized mode may not be used with the DeskJet devices. C C "Compressed" mode decreases the size of the bitmap file for later C model HP devices, particularly the DeskJet devices. C C----------------------------------------------------------------------- C C This driver was originally written by S. C. Allendorf and modified C by B. H. Toby. Any bugs are likely due to my (BHT) kludges. Send C improvements and fixes to this driver to sca@iowa.physics.uiowa.edu C (Internet) or IOWA::SCA (SPAN) and to TOBY@PETVAX.LRSM.UPENN.EDU. C C----------------------------------------------------------------------- C This is the number of currently C installed device types. INTEGER*4 NDEV PARAMETER (NDEV = 9) C LOGICAL INIT /.TRUE./ INTEGER*4 BX, BY, DEVICE, I, IC, IER INTEGER*4 LUN, NPICT REAL*4 XBUF(4) REAL*4 XMAX, YMAX CHARACTER ALTTYP(NDEV)*3, MODE*30, MSG*10 CHARACTER TYPE(NDEV)*4 INTEGER GRTRIM C! VAX/VMS INTEGER*4 GRFMEM, GRGMEM CHARACTER DEFNAM*12 PARAMETER (DEFNAM = 'PGPLOT.HJPLT') BYTE ESC, FF INTEGER*4 BUFFER C! PC: C! CHARACTER DEFNAM*4 C! PARAMETER (DEFNAM = 'LPT1') C! INTEGER*1 ESC, FF C! INTEGER*1 BUFFER[ALLOCATABLE, HUGE] (:,:) C PARAMETER (ESC = 27) PARAMETER (FF = 12) C actual settings LOGICAL TEX,NOFF REAL*4 T1,T2 REAL*4 dev_VC, dev_HC REAL*4 dev_resol,dev_maxX,dev_maxY LOGICAL dev_bitmap_L, dev_port_L, dev_cmprs_L CHARACTER dev_name*80 C These are the NDEV sets of C device characteristics. LOGICAL BITMAP(NDEV) 1 /.FALSE., .FALSE., .FALSE., .TRUE., .TRUE., 2 .TRUE., .TRUE., .TRUE., .TRUE./ LOGICAL PORTRAIT(NDEV) 1 /.FALSE., .TRUE., .TRUE., .FALSE., .TRUE., 2 .FALSE., .TRUE., .TRUE., .TRUE./ REAL*4 HC(NDEV) 1 / 0., 0., 0., 1.58, 1.22, 2 0., 0., 1.80, 1.05/ REAL*4 VC(NDEV) 1 / 0., 0., 0., 1.96, 2.42, 2 0., 0., 3.00, 2.23/ REAL*4 XPAGMX(NDEV) 1 / 10.25, 8.00, 8.00, 6.54, 5.65, 2 10.25, 8.00, 4.48, 6.00/ REAL*4 YPAGMX(NDEV) 1 / 8.00, 10.25, 10.25, 4.91, 5.65, 2 8.00, 10.25, 4.48, 6.00/ INTEGER*2 RESOL(NDEV) 1 / 300, 300, 300, 300, 300, 2 150, 150, 150, 100/ C Names for PGPLOT_HJ_MODE DATA TYPE / 'LHOR', 'PHOR', 'PHOT', 'LHBR', 'PHBS', 1 'LMBR', 'PMBR', 'PMBS', 'PLBS'/ C These names are around only for (pre)historical reasons. DATA ALTTYP / 'HPN', 'HPV', 'TEX', 'HPR', 'HPE', 1 'HPF', 'HPT', 'HPH', 'HPM'/ C----------------------------------------------------------------------- C----------------------------------------------------------------------- C First time, translate logical C name PGPLOT_HJ_MODE and set C device accordingly. IF (INIT) THEN CALL GRGENV ('HJ_MODE', MODE, I) DO 1 I = 1, NDEV WRITE (MSG, '(A2, I2.2)') 'HJ', I IF (MODE(1:4) .EQ. TYPE(I) .OR. 1 MODE(1:3) .EQ. ALTTYP(I) .OR. 2 MODE(1:4) .EQ. MSG(1:4)) THEN DEVICE = I GOTO 2 END IF 1 CONTINUE C If no match, choose LMBR DEVICE = 6 2 INIT = .FALSE. C See if user has chosen the C TeX plotfile format. TEX = .FALSE. IF (DEVICE .EQ. 3) TEX = .TRUE. dev_cmprs_L = .FALSE. C----------------------------------------------------------------------- C set actual device settings from table entries C dev_VC and dev_HC are margin settings in inches: for non-optimized bitmaps dev_VC = VC(DEVICE) dev_HC = HC(DEVICE) C dev_resol is the resolution in dots per inch dev_resol = RESOL(DEVICE) C dev_maxX and dev_maxY are the X and Y plot limits in inches dev_maxX = Xpagmx(DEVICE) dev_maxY = Ypagmx(DEVICE) C if dev_bitmap_L is false then the file can be optimized dev_bitmap_L = BITMAP(DEVICE) C if dev_port_L is false then a landscape orientation is used dev_port_L = PORTRAIT(DEVICE) C if TEX is true then much of the device control code is omitted so that C the file can be included by the TeX post-processor C----------------------------------------------------------------------- C Override the device settings according to logical variables: C PGPLOT_HJ_RES can be H or HIGH for 300 bpi C M or MEDIUM for 150 bpi C L or LOW for 100 bpi C V or VERYLOW for 75 bpi CALL GRGENV ('HJ_RES', MODE, I) IF (mode(1:1) .eq. 'H') then dev_resol = 300 ELSEIF (mode(1:1) .eq. 'M') then dev_resol = 150 ELSEIF (mode(1:1) .eq. 'L') then dev_resol = 100 ELSEIF (mode(1:1) .eq. 'V') then dev_resol = 75 C! ELSE C! for PC, set resolution to 150 dpi or less unless it has been C! specifically set to 300 C! dev_resol = min(150.,dev_resol) ENDIF C PGPLOT_HJ_MAR contains the vertical and horizontal margins in inches CALL GRGENV ('HJ_MAR', MODE, I) IF (i .gt. 0 .and. mode(:I) .ne. ' ') THEN read(mode(:I),'(2f6.0)',err=34) t1,t2 dev_VC = t1 dev_HC = t2 ENDIF C PGPLOT_HJ_SIZE if defined contains the X and Y page size in inches 34 CALL GRGENV ('HJ_SIZE', MODE, I) IF (i .gt. 0 .and. mode(:I) .ne. ' ') THEN read(mode(:I),'(2f6.0)',err=35) t1,t2 dev_maxX = t1 dev_maxY = t2 ENDIF C PGPLOT_HJ_TEX can have any value, if defined will set TeX mode 35 CALL GRGENV ('HJ_TEX', MODE, I) IF (i .gt. 0 .and. mode .ne. ' ') then TEX = .TRUE. ENDIF C PGPLOT_HJ_NOFF can have any value, if defined will skip the final C form feed -- this prevents wasted (blank) pages from spooled jobs NOFF = .false. CALL GRGENV ('HJ_NOFF', MODE, I) IF ((i .gt. 0 .and. mode .ne. ' ') .or. TEX) then NOFF = .true. ENDIF C If PGPLOT_HJ_PAGE is set to L (or LANDSCAPE) for Landscape mode C is set to P (or PORTRAIT) for Portrait mode CALL GRGENV ('HJ_PAGE', MODE, I) IF (mode(1:1) .eq. 'L' .or. mode(1:1) .eq. 'l') 1 dev_port_L = .false. IF (mode(1:1) .eq. 'P' .or. mode(1:1) .eq. 'p') 1 dev_port_L = .true. C If PGPLOT_HJ_OPT is set to O (or OPTIMIZE) the bitmap will be optimized C is set to C (or COMPRESS) the bitmap will be compressed CALL GRGENV ('HJ_OPT', MODE, I) IF (mode(1:1) .eq. 'O' .or. mode(1:1) .eq. 'o') 1 dev_bitmap_L = .FALSE. IF (mode(1:1) .eq. 'C' .or. mode(1:1) .eq. 'c') 1 dev_cmprs_L = .TRUE. C Define the device name to include the settings: name will be of form C /HJ -string C where the string will be "obrT x.x y.y" where C o P for Portrait orientation, L for landscape, blank otherwise C b O for optimized bitmaps, C for compressed bitmaps, B otherwise C r is the resolution in dots per inch: 300 - H; 150 - M; 100 - L; 75 - V C T for TeX mode, blank otherwise C x.x is the size of the page in the x direction C y.y is the size of the page in the y direction mode = 'L B' IF (dev_port_L) mode(1:1) = 'P' IF (.not. dev_bitmap_L) mode(2:2) = 'O' IF (dev_cmprs_L) mode(2:2) = 'C' IF (dev_resol .eq. 300) then mode(3:3) = 'H' ELSEIF (dev_resol .eq. 150) then mode(3:3) = 'M' ELSEIF (dev_resol .eq. 100) then mode(3:3) = 'L' ELSEIF (dev_resol .eq. 75) then mode(3:3) = 'V' ELSE mode(3:3) = '?' ENDIF IF (TEX) mode(4:4) = 'T' IF (dev_maxX .gt. 10) then WRITE (mode(5:),'(f3.0)') dev_maxX ELSE WRITE (mode(5:),'(f3.1)') dev_maxX ENDIF IF (dev_maxY .gt. 10) then WRITE (mode(9:),'(f3.0)') dev_maxY ELSE WRITE (mode(9:),'(f3.1)') dev_maxY ENDIF DEV_NAME = 'HJ (Hewlett-Packard Deskjet/Laserjet) ' // mode ENDIF C----------------------------------------------------------------------- C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in HJ "Jet" device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE CHR = dev_name NBUF = 0 LCHR = GRTRIM(dev_name) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 C convert dev_maxX and dev_maxY from inches to pixels RBUF(2) = dev_maxX * dev_resol - 1 RBUF(3) = 0.0 RBUF(4) = dev_maxY * dev_resol - 1 RBUF(5) = 0.0 RBUF(6) = 1.0 NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE RBUF(1) = dev_resol RBUF(2) = dev_resol RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, No area fill, C no thick lines) C 40 CONTINUE CHR = 'HNNNNNNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = DEFNAM NBUF = 0 LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 C convert dev_maxX and dev_maxY from inches to pixels RBUF(2) = dev_maxX * dev_resol - 1 RBUF(3) = 0.0 RBUF(4) = dev_maxY * dev_resol - 1 NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE IF (dev_resol .EQ. 300.0) THEN RBUF(1) = 3.0 ELSE IF (dev_resol .EQ. 150.0) THEN RBUF(1) = 2.0 ELSE RBUF(1) = 1.0 END IF NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C Obtain a logical unit number. CALL GRGLUN (LUN) C Check for an error. IF (LUN .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit.') RBUF(2) = 0 RETURN ELSE RBUF(1) = LUN END IF C Open the output file. OPEN (UNIT = LUN, FILE = CHR(:LCHR), CARRIAGECONTROL = 'NONE', 1 DEFAULTFILE = DEFNAM, STATUS = 'NEW', 2 RECL = 128, FORM = 'UNFORMATTED', RECORDTYPE = 'VARIABLE', 3 IOSTAT = IER) C! OPEN (UNIT = LUN, FILE = CHR(:LCHR), STATUS = 'UNKNOWN', C! 2 FORM = 'BINARY', C! 3 IOSTAT = IER) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for HP "Jet: plot: ' // 1 CHR(:LCHR)) C! CALL GRWARN ('Cannot open output file for HP "Jet" plot: ') C! CALL GRWARN (CHR(:LCHR)) RBUF(2) = 0 CALL GRFLUN (LUN) RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN, NAME = CHR) LCHR = LEN (CHR) 91 IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 91 END IF END IF C Initialize the plot file. IF (.NOT. TEX) THEN C Choose portrait orientation WRITE (LUN) ESC, '&l0O' C Set horizontal and vertical C spacing IF (dev_bitmap_L) THEN WRITE (LUN) ESC, '&l6C' WRITE (LUN) ESC, '&k10H' ELSE WRITE (LUN) ESC, '&k.4H' WRITE (LUN) ESC, '&l.16C' END IF WRITE (LUN) ESC, '&l2E' END IF C Set the graphics resolution WRITE (MSG, '(I3.3)') INT (dev_resol) WRITE (LUN) ESC, '*t', MSG(1:3), 'R' C Initialize the page counter. NPICT = 0 RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE IF (dev_bitmap_L) THEN WRITE (LUN) ESC, '&l8C' ELSEIF (.NOT. TEX) THEN WRITE (LUN) ESC, '&l6D' WRITE (LUN) ESC, '&k10H' WRITE (LUN) ESC, '&l2E' END IF C eject the page IF (.not. NOFF) WRITE (LUN) FF C Close the file. CLOSE (LUN, STATUS = 'KEEP') C Deallocate the logical unit. CALL GRFLUN (LUN) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Set the bitmap size. XMAX = RBUF(1) YMAX = RBUF(2) C Calculate the dimensions of the C plot buffer. IF (dev_port_L) THEN BX = INT (XMAX) / 8 + 1 BY = INT (YMAX) + 1 ELSE BX = INT (YMAX) / 8 + 1 BY = INT (XMAX) + 1 END IF C Allocate a plot buffer. C Check for error and clean up C if one was found. C! VAX IER = GRGMEM (BX * BY, BUFFER) IF (IER .NE. 1) THEN CALL GRGMSG (IER) C! PC C! ALLOCATE (BUFFER(BX,BY), STAT = IER) C! IF (IER .NE. 0) THEN CALL GRQUIT ('Failed to allocate a plot buffer.') END IF C Increment the page number. NPICT = NPICT + 1 C Eject the page from the printer. IF (NPICT .GT. 1) WRITE (LUN) FF C Set the cursor position and C start graphics mode. IF (dev_bitmap_L) THEN WRITE (MSG(1:4), '(I4.4)') nint(dev_HC*720.) WRITE (MSG(5:8), '(I4.4)') nint(dev_VC*720.) WRITE (LUN) ESC, '&a', MSG(1:4), 'h', MSG(5:8), 'V' END IF C Zero out the plot buffer. CALL GRHJ05 (BX * BY, %VAL(BUFFER)) RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Apply any needed tranformation. IF (dev_port_L) THEN DO 125 I = 1, 4 XBUF(I) = RBUF(I) 125 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) XBUF(3) = RBUF(4) XBUF(4) = XMAX - RBUF(3) END IF C Draw the point into the bitmap. CALL GRHJ00 (1, XBUF, IC, BX, BY, %VAL (BUFFER)) C! CALL GRHJ00 (1, XBUF, IC, BX, BY, BUFFER) RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Apply any needed tranformation. IF (dev_port_L) THEN DO 135 I = 1, 2 XBUF(I) = RBUF(I) 135 CONTINUE ELSE XBUF(1) = RBUF(2) XBUF(2) = XMAX - RBUF(1) END IF C Draw the point into the bitmap. CALL GRHJ00 (0, XBUF, IC, BX, BY, %VAL(BUFFER)) C! CALL GRHJ00 (0, XBUF, IC, BX, BY, BUFFER) RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Write out the bitmap. IF (dev_bitmap_L .and. dev_cmprs_L) THEN CALL GRHJ04 (LUN, BX, BY, %VAL(BUFFER)) C! CALL GRHJ04 (LUN, BX, BY, BUFFER) ELSEIF (dev_bitmap_L) THEN CALL GRHJ01 (LUN, BX, BY, %VAL (BUFFER)) C! CALL GRHJ01 (LUN, BX, BY, BUFFER) ELSE CALL GRHJ02 (LUN, BX, BY, %VAL (BUFFER), TEX) C! CALL GRHJ02 (LUN, BX, BY, BUFFER, TEX) END IF C Deallocate the plot buffer. C Check for an error. C! VAX IER = GRFMEM (BX * BY, BUFFER) IF (IER .NE. 1) THEN CALL GRGMSG (IER) C! PC C! DEALLOCATE (BUFFER, STAT=IER) C! IF (IER .NE. 0) THEN CALL GRWARN ('Failed to deallocate plot buffer.') END IF RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) C If out of range set to black. IF (IC .LT. 0 .OR. IC .GT. 1) THEN IC = 1 RBUF(1) = IC END IF RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C (Not implemented: should not be called.) C 190 CONTINUE GOTO 900 C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C (Not implemented: should not be called.) C 200 CONTINUE GOTO 900 C C--- IFUNC = 21, Set color representation. ----------------------------- C (Not implemented: ignored.) C 210 CONTINUE RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C (Not implemented: should not be called.) C 220 CONTINUE GOTO 900 C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C (Not implemented: should not be called.) C 240 CONTINUE GOTO 900 C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C*GRHJ00 -- PGPLOT Hewlett Packard LaserJet driver, draw line C+ SUBROUTINE GRHJ00 (LINE, RBUF, ICOL, BX, BY, BITMAP) INTEGER*4 BX, BY, ICOL, LINE BYTE BITMAP(BX, BY) C! INTEGER*1 BITMAP(BX, BY) REAL*4 RBUF(4) C C Draw a straight line segment from absolute pixel coordinates (RBUF(1), C RBUF(2)) to (RBUF(3), RBUF(4)). The line either overwrites (sets to C black) or erases (sets to white) the previous contents of the bitmap, C depending on the current color index. Setting bits is accomplished C with a VMS BISB2 instruction, expressed in Fortran as .OR.; clearing C bits is accomplished with a VMS BICB2 instruction, expressed in C Fortran as .AND. .NOT.. The line is generated with a Simple Digital C Differential Analyser (ref: Newman & Sproull). C C Arguments: C C LINE I I =0 for dot, =1 for line. C RBUF(1),RBUF(2) I R Starting point of line. C RBUF(3),RBUF(4) I R Ending point of line. C ICOL I I =0 for erase, =1 for write. C BITMAP I/O B (address of) the frame buffer. C C----------------------------------------------------------------------- BYTE QMASK(0 : 7) C! INTEGER*1 QMASK(0 : 7) INTEGER*4 K, KX, KY, LENGTH REAL*4 D, XINC, XP, YINC, YP DATA QMASK /'80'X, '40'X, '20'X, '10'X, 1 '08'X, '04'X, '02'X, '01'X/ C! DATA QMASK /16#80, 16#40, 16#20, 16#10, C! 1 16#08, 16#04, 16#02, 16#01/ C----------------------------------------------------------------------- IF (LINE .GT. 0) THEN D = MAX (ABS (RBUF(3) - RBUF(1)), ABS (RBUF(4) - RBUF(2))) LENGTH = D IF (LENGTH .EQ. 0) THEN XINC = 0.0 YINC = 0.0 ELSE XINC = (RBUF(3) - RBUF(1)) / D YINC = (RBUF(4) - RBUF(2)) / D END IF ELSE LENGTH = 0 XINC = 0.0 YINC = 0.0 END IF XP = RBUF(1) + 0.5 YP = RBUF(2) + 0.5 IF (ICOL .NE. 0) THEN DO K = 0, LENGTH KX = XP KY = (BY - 1) - INT (YP) BITMAP(KX / 8 + 1, KY + 1) = BITMAP(KX / 8 + 1, KY + 1) .OR. 1 QMASK(MOD (KX, 8)) XP = XP + XINC YP = YP + YINC END DO ELSE DO K = 0,LENGTH KX = XP KY = (BY - 1) - INT (YP) BITMAP(KX / 8 + 1, KY + 1) = BITMAP(KX / 8 + 1, KY + 1) 1 .AND. (.NOT. QMASK(MOD (KX, 8))) XP = XP + XINC YP = YP + YINC END DO END IF C----------------------------------------------------------------------- RETURN END C*GRHJ01 -- PGPLOT LaserJet driver, copy bitmap to output file C+ SUBROUTINE GRHJ01 (LUN, BX, BY, BITMAP) INTEGER BX, BY, LUN BYTE BITMAP(BX, BY) C! INTEGER*1 BITMAP(BX, BY) C C Arguments: C C LUN (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE ESC C! INTEGER*1 ESC INTEGER I, J, K CHARACTER KSTR*3 PARAMETER (ESC = 27) C----------------------------------------------------------------------- C Start graphics mode WRITE (LUN) ESC, '*r1A' C Loop through bitmap DO J = 1, BY C Search for last non-NUL DO K = BX, 2, -1 IF (BITMAP(K, J) .NE. 0) GO TO 10 END DO C Guarantee that we know what K C is after loop. C (Remember FORTRAN IV!?) K = 1 C Encode length of line 10 WRITE (KSTR, '(I3.3)') K C Write out the raster line WRITE (LUN) ESC, '*b', KSTR, 'W', (BITMAP(I, J), I = 1, K) END DO C Turn off graphics mode. WRITE (LUN) ESC, '*rB' C----------------------------------------------------------------------- RETURN END C*GRHJ02 -- PGPLOT LaserJet+ driver, dump bitmap to device C+ SUBROUTINE GRHJ02 (LUN, BX, BY, BITMAP, TEX) LOGICAL TEX INTEGER LUN, BX, BY BYTE BITMAP(BX, BY) C! INTEGER*1 BITMAP(BX, BY) C C Output raster for this page. This routine has been optimised to C minimize the memory usage in the LaserJet. This sometimes leads to a C larger file than if a straight bitmap approach had been used. C C NOTE: This subroutine is a kludge to make a 512K LaserJet produce C full page plots at 300dpi. It will not always produce the plot C on one page. If you overrun the memory restrictions, two pages C will be printed, each containing parts of the plot. One must C then resort to cut and paste techniques to restore the plot. C Most simple line graphs do not come close to the memory limit, C but sometimes a messy contour plot will. DON'T EVEN THINK C ABOUT SENDING A GREYSCALE TO THIS SUBROUTINE! C C Arguments: C C LUN I I Logical unit number of output file C BX, BY I I Dimensions of frame buffer C BITMAP I/O B (address of) the frame buffer. C C Version 1.0 03-Sep-1986 S. C. Allendorf C Version 2.0 08-Dec-1986 S. C. Allendorf Use relative positioning C Version 2.1 28-Dec-1986 S. C. Allendorf Optimize positioning code C Version 3.0 02-Jan-1987 S. C. Allendorf Add code for rules C VERSION 3.1 10-FEB-1988 S. C. Allendorf Attempt to speed up code C----------------------------------------------------------------------- BYTE ESC, N0 C! INTEGER*1 ESC, N0 LOGICAL NOBIT INTEGER*4 CNUM, CONUM, CURCOL, CURROW, FB(35), FB2(25), I, IPOS INTEGER*4 IYOFF, J, K, L, M, N, NB(35), NBNUM, NBTOT, NBNUM2 INTEGER*4 NB2(25), RNUM, RONUM, GRHJ03 CHARACTER ALLONE*300, COL*5, NBYTE*4, NULLS*(10), ROW*5, X*300 PARAMETER (N0 = 0) PARAMETER (ESC = 27) C----------------------------------------------------------------------- C Define some useful constants IF (TEX) THEN IYOFF = 0 ELSE IYOFF = 75 END IF DO J = 1, 10 NULLS(J:J) = CHAR (0) END DO DO J = 1, 300 ALLONE(J:J) = CHAR (255) END DO C Initialize some variables CURCOL = 0 CURROW = 0 C Position the cursor IF (.NOT. TEX) THEN WRITE (LUN) ESC, '*p0y0X' END IF C Set up vertical rule height WRITE (LUN) ESC, '*c1B' C Write out each line on page DO K = 1, BY C Copy raster to buffer and find C the beginning and end of the C bitmap line NOBIT = .TRUE. NBTOT = 0 FB(1) = BX DO J = 1, BX X(J:J) = CHAR (BITMAP(J,K)) IF (X(J:J) .NE. NULLS(1:1)) THEN NOBIT = .FALSE. NBTOT = J FB(1) = MIN (FB(1), J) END IF END DO C Break line into pieces IF (.NOT. NOBIT) THEN L = 1 GO TO 20 10 NB(L) = FB(L) + IPOS - 2 L = L + 1 C Search for first non-null DO J = NB(L-1) + 11, NBTOT IF (X(J:J) .NE. NULLS(1:1)) THEN FB(L) = J GO TO 20 END IF END DO C Search for a string of nulls 20 IPOS = INDEX (X(FB(L):NBTOT), NULLS) IF (IPOS .EQ. 0) THEN NB(L) = NBTOT GO TO 30 ELSE GO TO 10 END IF C Loop through each substring 30 DO J = 1, L C Search for rules M = 1 FB2(1) = FB(J) GO TO 50 40 IF (IPOS .NE. 1) THEN NB2(M) = 0 DO I = FB2(M), FB2(M) + IPOS - 2 IF (X(I:I) .NE. NULLS(1:1)) THEN NB2(M) = MAX (FB2(M), I) END IF END DO M = M + 1 FB2(M) = FB2(M-1) + IPOS - 1 IF (NB2(M-1) .EQ. 0) THEN FB2(M-1) = FB2(M) M = M - 1 END IF END IF C Search for first non- DO N = FB2(M) + 25, NB(J) IF (X(N:N) .NE. ALLONE(1:1)) THEN NB2(M) = N - 1 M = M + 1 FB2(M) = N GO TO 50 END IF END DO NB2(M) = NB(J) GO TO 60 C Search for a string of s 50 IPOS = INDEX (X(FB2(M):NB(J)), ALLONE(1:25)) IF (IPOS .EQ. 0) THEN NB2(M) = NB(J) GO TO 60 ELSE GO TO 40 END IF C Print each of the substrings 60 DO I = 1, M C Get the number of bytes NBNUM = NB2(I) - FB2(I) + 1 WRITE (NBYTE, 1000) NBNUM NBNUM2 = GRHJ03 (NBNUM) C Calculate the row and column RONUM = K + IYOFF CONUM = (FB2(I) - 1) * 8 C Determine the positioning C sequence and write it out IF (RONUM .NE. CURROW .AND. CONUM .NE. CURCOL) THEN RNUM = RONUM - CURROW CNUM = CONUM - CURCOL WRITE (ROW, 1010) RNUM WRITE (COL, 1010) CNUM RNUM = GRHJ03 (ABS (RNUM)) + 1 CNUM = GRHJ03 (ABS (CNUM)) + 1 WRITE (LUN) ESC, '*p', ROW(6-RNUM:5), 'y', + COL(6-CNUM:5), 'X' ELSE IF (RONUM .NE. CURROW) THEN RNUM = RONUM - CURROW WRITE (ROW, 1010) RNUM RNUM = GRHJ03 (ABS (RNUM)) + 1 WRITE (LUN) ESC, '*p', ROW(6-RNUM:5), 'Y' ELSE IF (CONUM .NE. CURCOL) THEN CNUM = CONUM - CURCOL WRITE (COL, 1010) CNUM CNUM = GRHJ03 (ABS (CNUM)) + 1 WRITE (LUN) ESC, '*p', COL(6-CNUM:5), 'X' END IF C Check for all bits set in C substring IF ((INDEX (X(FB2(I):NB2(I)), ALLONE(1:NBNUM)) .EQ. 1) + .AND. NBNUM .GE. 5) THEN NBNUM = NBNUM * 8 WRITE (NBYTE, 1000) NBNUM NBNUM2 = GRHJ03 (NBNUM) WRITE (LUN) ESC, '*c', NBYTE(5-NBNUM2:4), 'A' WRITE (LUN) ESC, '*c0P' CURROW = RONUM CURCOL = CONUM ELSE C Write out raster line WRITE (LUN) ESC, '*r1A' WRITE (LUN) ESC, '*b', NBYTE(5-NBNUM2:4), 'W', + X(FB2(I):NB2(I)) WRITE (LUN) ESC, '*rB' CURROW = RONUM + 1 CURCOL = CONUM END IF END DO END DO END IF END DO C----------------------------------------------------------------------- 1000 FORMAT (I4.4) 1010 FORMAT (SP,I5) RETURN END C*GRHJ03 -- PGPLOT LaserJet+ driver, calculate length of an integer C+ INTEGER FUNCTION GRHJ03 (I) INTEGER I C C This function calculates the number of digits in a supplied integer. C C Arguments: C C I I I Integer value of number C GRHJ03 O I Length of printed representation of I C C Version 1.0 10-Feb-1988 S. C. Allendorf C----------------------------------------------------------------------- IF (I .GE. 10) THEN IF (I .GE. 100) THEN IF (I .GE. 1000) THEN GRHJ03 = 4 ELSE GRHJ03 = 3 END IF ELSE GRHJ03 = 2 END IF ELSE GRHJ03 = 1 END IF C----------------------------------------------------------------------- RETURN END C*GRHJ04 -- PGPLOT LaserJet driver, copy bitmap to output file with C compression -- for DESKJET PLUS and possibly other printers C+ SUBROUTINE GRHJ04 (LUN, BX, BY, BITMAP) INTEGER BX, BY, LUN BYTE BITMAP(BX, BY) C! INTEGER*1 BITMAP(BX, BY) C C Arguments: C C LUN (input) Fortran unit number for output C BX, BY (input) dimensions of BITMAP C BITMAP (input) the bitmap array C----------------------------------------------------------------------- BYTE ESC C! INTEGER*1 ESC INTEGER K1, J, K, BXMAX,BXMIN CHARACTER KSTR*3 PARAMETER (ESC = 27) CHARACTER*10 BUFF1 C! integer*1 BUFF2(400) byte BUFF2(400) integer lbuf1,lbuf2,tbuf byte tbufb(2) equivalence (tbuf,tbufb) C----------------------------------------------------------------------- C Start graphics mode WRITE (LUN) ESC, '*r1A' C Loop through bitmap DO J = 1, BY C Search for last non-NUL DO K = BX, 2, -1 IF (BITMAP(K, J) .NE. 0) GO TO 10 END DO C Guarantee that we know what K C is after loop. C (Remember FORTRAN IV!?) K = 1 10 BXMAX = K BXMIN = 1 K = 1 BUFF1(1:1) = CHAR(27) BUFF1(2:5) = '*b2m' lbuf1 = 5 C If there are less than 4 bytes don't bother with an offset IF (BXMAX .LE. 4) GOTO 25 C Count the number of Zero bits at beginning of line DO K = BXMIN,BXMAX-1 IF (BITMAP(K, J) .NE. 0) GO TO 20 ENDDO K = BXMAX 20 IF (K .GT. 4) THEN K1 = (K-1)*8 BXMIN = K IF (K1 .LE. 9) THEN LBUF1 = 7 WRITE (BUFF1(6:LBUF1),'(I1.1,A1)') K1,'x' ELSEIF (K1 .LE. 99) THEN LBUF1 = 8 WRITE (BUFF1(6:LBUF1),'(I2.2,A1)') K1,'x' ELSEIF (K1 .LE. 999) THEN LBUF1 = 9 WRITE (BUFF1(6:LBUF1),'(I3.3,A1)') K1,'x' ELSE LBUF1 = 10 WRITE (BUFF1(6:LBUF1),'(I4.4,A1)') K1,'x' ENDIF ENDIF 25 WRITE (LUN) BUFF1(1:LBUF1) lbuf2 = 1 30 CONTINUE DO K = BXMIN,BXMAX IF (K .GE. BXMAX-2) THEN C we are at the end of the bit-map, C N.B. BXMAX - BXMIN will be less than 128 buff2(lbuf2) = BXMAX - BXMIN lbuf2 = lbuf2 + 1 DO K1=BXMIN,BXMAX buff2(lbuf2) = BITMAP(K1, J) lbuf2 = lbuf2 + 1 ENDDO GOTO 100 ELSEIF (K - BXMIN .GE. 125) THEN C we have 126 non-repeated characters buff2(lbuf2) = K - BXMIN lbuf2 = lbuf2 + 1 DO K1=BXMIN,K buff2(lbuf2) = BITMAP(K1, J) lbuf2 = lbuf2 + 1 ENDDO BXMIN = K+1 IF (BXMIN .GT. BXMAX) GOTO 100 GOTO 30 ELSEIF (BITMAP(K, J) .EQ. BITMAP(K+1, J) .AND. 1 BITMAP(K, J) .EQ. BITMAP(K+2, J)) THEN C we have 2 or more repeated characters IF (K .gt. BXMIN) THEN C write out non-repeated characters, if any buff2(lbuf2) = K - BXMIN - 1 lbuf2 = lbuf2 + 1 DO K1=BXMIN,K-1 buff2(lbuf2) = BITMAP(K1, J) lbuf2 = lbuf2 + 1 ENDDO ENDIF C count the number of repeated characters, up to 127 DO K1=K+3,MIN(BXMAX,K+127) IF (BITMAP(K, J) .NE. BITMAP(K1, J)) GOTO 40 ENDDO K1 = BXMAX + 1 C write out repeated characters 40 CONTINUE C! VAX version: Tbuf = 257 - K1 + K buff2(lbuf2) = tbufb(1) C PC version: C! buff2(lbuf2) = 257 - (K1 - K) lbuf2 = lbuf2 + 1 buff2(lbuf2) = BITMAP(K, J) lbuf2 = lbuf2 + 1 BXMIN = K1 IF (BXMIN .GT. BXMAX) GOTO 100 GOTO 30 ENDIF ENDDO 100 WRITE (KSTR, '(I3.3)') lbuf2-1 IF (lbuf2 .LE. 10) THEN WRITE (LUN) KSTR(3:3), 'W', (BUFF2(k1),k1=1,lbuf2-1) ELSEIF (lbuf2 .LE. 100) THEN WRITE (LUN) KSTR(2:3), 'W', (BUFF2(k1),k1=1,lbuf2-1) ELSE WRITE (LUN) KSTR(1:3), 'W', (BUFF2(k1),k1=1,lbuf2-1) ENDIF C Write out the raster line END DO C Turn off graphics mode. WRITE (LUN) ESC, '*rB' C----------------------------------------------------------------------- RETURN END C*GRHJ05 -- zero fill buffer C+ SUBROUTINE GRHJ05 (BUFSIZ,BUFFER) C C Arguments: C C BUFFER (byte array, input): (address of) the buffer. C BUFSIZ (integer, input): number of bytes in BUFFER. C----------------------------------------------------------------------- INTEGER BUFSIZ, I BYTE BUFFER(BUFSIZ), FILL DATA FILL/0/ C DO 10 I=1,BUFSIZ BUFFER(I) = FILL 10 CONTINUE END = 1, pgplot/drivers/rvdriv.c010064400040640000322000000042630631707046700157070ustar00tjpcitmbr00000400000017#include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow tkdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call rvdriv() or rvdriv_(). */ #ifdef PG_PPU #define RVDRIV rvdriv_ #else #define RVDRIV rvdriv #endif /*....................................................................... * This is a stub version of the Rivet-Tk PGPLOT widget device driver to * be included in the main PGPLOT library. The real driver resides in a * dedicated library, which when cited before libpgplot on the link line, * overrides this stub. The rational behind this is that if the real * driver were included in the PGPLOT library all applications that are * currently linked with PGPLOT would have to be changed to link with the * Tcl/Tk libraries. */ #ifdef VMS void rvdriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void RVDRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif int i; /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: for(i=0; i < len; i++) chr[i] = ' '; *lchr = 0; break; default: fprintf(stderr, "/XRV: Unexpected opcode=%d in stub driver.\n", *ifunc); *nbuf = -1; break; }; return; } pgplot/drivers/tkdriv.c010064400040640000322000000042550631514740200156670ustar00tjpcitmbr00000400000017#include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow tkdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call tkdriv() or tkdriv_(). */ #ifdef PG_PPU #define TKDRIV tkdriv_ #else #define TKDRIV tkdriv #endif /*....................................................................... * This is a stub version of the Tk PGPLOT widget device driver to * be included in the main PGPLOT library. The real driver resides in a * dedicated library, which when cited before libpgplot on the link line, * overrides this stub. The rational behind this is that if the real * driver were included in the PGPLOT library all applications that are * currently linked with PGPLOT would have to be changed to link with the * Tcl/Tk libraries. */ #ifdef VMS void tkdriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void TKDRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif int i; /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: for(i=0; i < len; i++) chr[i] = ' '; *lchr = 0; break; default: fprintf(stderr, "/XTK: Unexpected opcode=%d in stub driver.\n", *ifunc); *nbuf = -1; break; }; return; } pgplot/drivers/xtk/pgtkdemo.c010064400040640000322000001036300653610562000170020ustar00tjpcitmbr00000400000017#include #include #include #include #include #include "tkpgplot.h" #include "cpgplot.h" /* Set the default image size */ enum {IMAGE_SIZE=129}; /* Set the number of points plotted per slice */ enum {SLICE_SIZE=100}; /* * The demo supports several 2D functions that are displayed in * its image window. For each supported function-type there is a * C function of the following declaration, that returns the * value of the function at a given x,y position. */ #define IMAGE_FN(fn) float (fn)(float x, float y) /* * List the prototypes of the available 2D-function functions. */ static IMAGE_FN(sinc_fn); static IMAGE_FN(gaus_fn); static IMAGE_FN(ring_fn); static IMAGE_FN(sin_angle_fn); static IMAGE_FN(cos_radius_fn); static IMAGE_FN(star_fn); /* * List the association between image function name and the functions * that evaluate them. */ static struct { char *name; /* The TCL name for the function */ IMAGE_FN(*fn); /* The C function that evaluates the function */ } image_functions[] = { {"cos(R)sin(A)", ring_fn}, {"sinc(R)", sinc_fn}, {"exp(-R^2/20.0)", gaus_fn}, {"sin(A)", sin_angle_fn}, {"cos(R)", cos_radius_fn}, {"(1+sin(6A))exp(-R^2/100)", star_fn} }; /* * Declare a type to hold a single X,Y coordinate. */ typedef struct { double x, y; /* World coordinates */ } Vertex; /* * Declare the object type that is used to record the state of a * given demo instance command. */ typedef struct { Tcl_Interp *interp; /* The TCL interpreter of the demo */ int image_id; /* The PGPLOT id of the image widget */ int slice_id; /* The PGPLOT id of the slice widget */ float *image; /* The gray-scale image array */ float *slice; /* The slice compilation array */ float scale; /* Coversion factor pixels -> coords */ int image_size; /* The number of pixels along each side of the image */ int slice_size; /* The length of the slice array */ int xa,xb; /* Min and max X pixel coordinates */ int ya,yb; /* Min and max Y pixel coordinates */ float datamin; /* The minimum data value in image[] */ float datamax; /* The maximum data value in image[] */ IMAGE_FN(*fn); /* The function to be displayed */ Vertex va; /* The start of the latest slice line */ Vertex vb; /* The end of the latest slice line */ int have_slice; /* This true when va and vb contain valid slice limits */ int monochrome; /* True if the image colormap only contains two colors */ } Pgdemo; static Pgdemo *new_Pgdemo(Tcl_Interp *interp, char *caller, char *cmd, char *image_device, char *slice_device); static Pgdemo *del_Pgdemo(Pgdemo *demo); static void Pgdemo_DeleteProc(ClientData data); static int pgdemo_instance_command(ClientData data, Tcl_Interp *interp, int argc, char *argv[]); static int pgdemo_save_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]); static int pgdemo_function_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]); static int pgdemo_slice_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]); static int pgdemo_redraw_slice_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]); static int pgdemo_recolor_image_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]); static int demo_display_fn(Pgdemo *demo, Tcl_Interp *interp, IMAGE_FN(*fn)); static int demo_display_image(Pgdemo *demo, int id); static int demo_display_slice(Pgdemo *demo, Vertex *va, Vertex *vb); static void demo_display_help(Pgdemo *demo); static void demo_display_busy(Pgdemo *demo); static void Pgdemo_DeleteProc(ClientData data); static int create_pgdemo(ClientData data, Tcl_Interp *interp, int argc, char *argv[]); static int valid_demo_script(char *name); static int Demo_AppInit(Tcl_Interp *interp); /* * Define some color tables. */ /* * Define single-color ramp functions. */ static float grey_l[] = {0.0,1.0}; static float grey_c[] = {0.0,1.0}; /* * Define a rainbow color table. */ static float rain_l[] = {-0.5, 0.0, 0.17, 0.33, 0.50, 0.67, 0.83, 1.0, 1.7}; static float rain_r[] = { 0.0, 0.0, 0.0, 0.0, 0.6, 1.0, 1.0, 1.0, 1.0}; static float rain_g[] = { 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.6, 0.0, 1.0}; static float rain_b[] = { 0.0, 0.3, 0.8, 1.0, 0.3, 0.0, 0.0, 0.0, 1.0}; /* * Iraf "heat" color table. */ static float heat_l[] = {0.0, 0.2, 0.4, 0.6, 1.0}; static float heat_r[] = {0.0, 0.5, 1.0, 1.0, 1.0}; static float heat_g[] = {0.0, 0.0, 0.5, 1.0, 1.0}; static float heat_b[] = {0.0, 0.0, 0.0, 0.3, 1.0}; /* * AIPS tvfiddle discrete rainbow color table. */ static float aips_l[] = {0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4, 0.5, 0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9, 1.0}; static float aips_r[] = {0.0, 0.0, 0.3, 0.3, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0}; static float aips_g[] = {0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.8, 0.8, 0.6, 0.6, 1.0, 1.0, 1.0, 1.0, 0.8, 0.8, 0.0, 0.0}; static float aips_b[] = {0.0, 0.0, 0.3, 0.3, 0.7, 0.7, 0.7, 0.7, 0.9, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0}; /* * Define a macro that returns the number of elements in a static array. */ #ifdef COUNT #undef COUNT #endif #define COUNT(lev) sizeof(lev)/sizeof(lev[0]) /* * List the supported color tables. */ typedef struct { char *name; /* The name of the color table */ int n; /* The number of nodes in the color table */ float *l; /* The normalized color-table positions of the n nodes */ float *r; /* The n red normalized intensities */ float *g; /* The n green normalized intensities */ float *b; /* The n blue normalized intensities */ } Cmap; static Cmap std_cmaps[] = { {"grey", COUNT(grey_l), grey_l, grey_c, grey_c, grey_c}, {"rainbow", COUNT(rain_l), rain_l, rain_r, rain_g, rain_b}, {"heat", COUNT(heat_l), heat_l, heat_r, heat_g, heat_b}, {"aips", COUNT(aips_l), aips_l, aips_r, aips_g, aips_b}, }; static int n_std_cmap = COUNT(std_cmaps); /*....................................................................... * After presenting a warning if the first argument is not the name * of the demo Tcl script, main() simply calls the standard Tk_Main() * to initialize Tcl/Tk and the demo package. * Input: * argc int The number of command line arguments. * argv char*[] The array of command-line argument strings. * Output: * return int 0 - OK. * 1 - Error. */ int main(int argc, char *argv[]) { char *usage = "Usage: pgtkdemo pgtkdemo.tcl [tk-options].\n"; /* * Check whether the first argument names a valid pgtkdemo * script file. */ if(argc < 2 || *argv[1] == '-' || !valid_demo_script(argv[1])) { fprintf(stderr, usage); return 1; }; /* * Start the application. */ Tk_Main(argc, argv, Demo_AppInit); return 0; } /*....................................................................... * This dummy fortran main allows pgtkdemo to be linked with the * f2c-compiled pgplot library. */ int MAIN__(void) { } /*....................................................................... * This is the application initialization file that is called by Tk_Main(). */ static int Demo_AppInit(Tcl_Interp *interp) { /* * Create the standard Tcl and Tk packages, plus the TkPgplot package. */ if(Tcl_Init(interp) == TCL_ERROR || Tk_Init(interp) == TCL_ERROR || Tkpgplot_Init(interp) == TCL_ERROR) return 1; /* * Create the TCL command used to initialization the demo. */ Tcl_CreateCommand(interp, "create_pgdemo", create_pgdemo, (ClientData) Tk_MainWindow(interp), 0); return 0; } /*....................................................................... * This function provides the TCL command that creates a pgdemo * manipulation command. This opens the two given PGPLOT widgets to * PGPLOT, establishes a cursor handler and records the state of the * demo in a dynamically allocated container. * * Input: * data ClientData The main window cast to ClientData. * interp Tcl_Interp * The TCL intrepreter of the demo. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * argv[0] = "create_pgdemo" * argv[1] = The name to give the new command. * argv[2] = The name of the image widget. * argv[3] = The name of the slice widget. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int create_pgdemo(ClientData data, Tcl_Interp *interp, int argc, char *argv[]) { Pgdemo *demo; /* The new widget instance object */ /* * Check that the right number of arguments was provided. */ if(argc != 4) { Tcl_AppendResult(interp, argv[0], ": Wrong number of arguments - should be \'", argv[0], " new_command_name image_widget slice_widget\'", NULL); return TCL_ERROR; }; /* * Allocate a context object for the command. */ demo = new_Pgdemo(interp, argv[0], argv[1], argv[2], argv[3]); if(!demo) return TCL_ERROR; return TCL_OK; } /*....................................................................... * Create a new PGPLOT demo instance command and its associated context * object. * * Input: * interp Tcl_Interp * The TCL interpreter object. * caller char * The name of the calling TCL command. * cmd char * The name to give the new demo-instance command. * image_device char * The PGPLOT device specification to use to open * the image-display device. * slice_device char * The PGPLOT device specification to use to open * the slice-display device. * Output: * return Pgdemo * The new demo object, or NULL on error. * If NULL is returned then the context of the * error will have been recorded in the result * field of the interpreter. */ static Pgdemo *new_Pgdemo(Tcl_Interp *interp, char *caller, char *cmd, char *image_device, char *slice_device) { Pgdemo *demo; /* The new widget object */ int minind, maxind; /* The min/max color indexes available for images */ int i; /* * Allocate the container. */ demo = (Pgdemo *) malloc(sizeof(Pgdemo)); if(!demo) { Tcl_AppendResult(interp, "Insufficient memory to create ", cmd, NULL); return NULL; }; /* * Before attempting any operation that might fail, initialize the container * at least up to the point at which it can safely be passed to * del_Pgdemo(). */ demo->interp = interp; demo->image_id = -1; demo->slice_id = -1; demo->image = NULL; demo->slice = NULL; demo->image_size = IMAGE_SIZE; demo->slice_size = SLICE_SIZE; demo->scale = 40.0f/demo->image_size; demo->xa = -(int)demo->image_size/2; demo->xb = demo->image_size/2; demo->ya = -(int)demo->image_size/2; demo->yb = demo->image_size/2; demo->fn = sin_angle_fn; demo->have_slice = 0; demo->monochrome = 0; /* * Attempt to open the image and slice widgets. */ if((demo->image_id = cpgopen(image_device)) <= 0 || (demo->slice_id = cpgopen(slice_device)) <= 0) { Tcl_AppendResult(interp, "Unable to open widgets: ", image_device, ", ", slice_device, NULL); return del_Pgdemo(demo); }; /* * Now allocate the 2D image array as a 1D array to be indexed in * as a FORTRAN array. */ demo->image = (float *) malloc(sizeof(float) * demo->image_size * demo->image_size); if(!demo->image) { Tcl_AppendResult(interp, "new_Pgdemo: Insufficient memory.", NULL); return del_Pgdemo(demo); }; /* * Initialize the image array. */ for(i=0; iimage_size*demo->image_size; i++) demo->image[i] = 0.0f; /* * Allocate an array to be used when constructing slices through the * displayed image. */ demo->slice = (float *) malloc(sizeof(float) * demo->slice_size); if(!demo->slice) { Tcl_AppendResult(interp, "new_Pgdemo: Insufficient memory.", NULL); return del_Pgdemo(demo); }; /* * Initialize the slice array. */ for(i=0; islice_size; i++) demo->slice[i] = 0.0f; /* * If there are fewer than 2 colors available for plotting images, * mark the image as monochrome so that pggray can be asked to * produce a stipple version of the image. */ cpgslct(demo->image_id); cpgqcir(&minind, &maxind); demo->monochrome = maxind-minind+1 <= 2; /* * Create the instance command. */ Tcl_CreateCommand(interp, cmd, pgdemo_instance_command, (ClientData)demo, Pgdemo_DeleteProc); /* * Return the command name. */ Tcl_AppendResult(interp, cmd, NULL); return demo; } /*....................................................................... * Delete the context of a Pgdemo instance command. * * Input: * demo Pgdemo * The widget to be deleted. * Output: * return Pgdemo * Always NULL. */ static Pgdemo *del_Pgdemo(Pgdemo *demo) { if(demo) { demo->interp = NULL; /* * Close the PGPLOT widgets. */ if(demo->image_id > 0) { cpgslct(demo->image_id); cpgclos(); demo->image_id = -1; }; if(demo->slice_id > 0) { cpgslct(demo->slice_id); cpgclos(); demo->slice_id = -1; }; /* * Delete the container. */ free(demo); }; return NULL; } /*....................................................................... * This is a wrapper around del_Pgdemo() suitable to be registered as * a DeleteProc callback for Tcl_CreateCommand(). * * Input: * data ClientData The (Pgdemo *) object cast to ClientData. */ static void Pgdemo_DeleteProc(ClientData data) { (void) del_Pgdemo((Pgdemo *) data); } /*....................................................................... * This function implements a given Tcl PGPLOT demo instance command. * * Input: * data ClientData The demo context object cast to (ClientData). * interp Tcl_Interp * The TCL intrepreter. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * argv[0] - the name of the demo command. * argv[1..] - One of: * save device_spec * function image_function * slice x1 y1 x2 y2 * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int pgdemo_instance_command(ClientData data, Tcl_Interp *interp, int argc, char *argv[]) { Pgdemo *demo = (Pgdemo *) data; char *command; /* The name of the command */ /* * We must have at least one command argument. */ if(argc < 2) { Tcl_SetResult(interp, "Wrong number of arguments.", TCL_STATIC); return TCL_ERROR; }; /* * Get the command-name argument. */ command = argv[1]; if(strcmp(command, "save") == 0) return pgdemo_save_command(demo, interp, argc - 2, argv + 2); else if(strcmp(command, "function") == 0) return pgdemo_function_command(demo, interp, argc - 2, argv + 2); else if(strcmp(command, "slice") == 0) return pgdemo_slice_command(demo, interp, argc - 2, argv + 2); else if(strcmp(command, "redraw_slice") == 0) return pgdemo_redraw_slice_command(demo, interp, argc - 2, argv + 2); else if(strcmp(command, "recolor_image") == 0) return pgdemo_recolor_image_command(demo, interp, argc - 2, argv + 2); /* * Unknown command name. */ Tcl_AppendResult(interp, argv[0], ": Unknown demo command \"", argv[1], "\"", NULL); return TCL_ERROR; } /*....................................................................... * Implement the demo "save" command. This takes a PGPLOT device * specification as its argument. * * Input: * demo Pgdemo * The demo being serviced. * interp Tcl_Interp * The TCL interpreter of the demo. * argc int The number of TCL arguments in argv[]. * argv char ** An array of 'argc' TCL arguments. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int pgdemo_save_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]) { char *device; /* The PGPLOT device specification */ int device_id; /* The PGPLOT id of the new device */ /* * There should only be a single argument. */ if(argc != 1) { Tcl_AppendResult(interp, "Missing PGPLOT device specification.\n", NULL); return TCL_ERROR; }; /* * Get the device specification. */ device = argv[0]; /* * Open the new PGPLOT device. */ device_id = cpgopen(device); /* * If the device was successfully opened, plot the current image * within it and close the device. */ if(device_id > 0) { demo_display_image(demo, device_id); cpgclos(); } else { Tcl_AppendResult(interp, "cpgopen(\"", device, "\") failed.", NULL); return TCL_ERROR; }; return TCL_OK; } /*....................................................................... * Implement the demo "function" command. This takes one of a set of * supported function-designations and displays it in the image window. * * Input: * demo Pgdemo * The demo being serviced. * interp Tcl_Interp * The TCL interpreter of the demo. * argc int The number of TCL arguments in argv[]. * argv char ** An array of 'argc' TCL arguments. * argv[0] - A function designation chosen from: * "cos(R)sin(A)" * "sinc(R)" * "exp(-R^2/20.0)" * "sin(A)" * "cos(A)" * "(1+sin(6A))exp(-R^2/100)" * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int pgdemo_function_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]) { char *function; /* The name of the display function */ int i; /* * There should only be a single argument. */ if(argc != 1) { Tcl_AppendResult(interp, "Missing image function name.\n", NULL); return TCL_ERROR; }; /* * Get the function specification. */ function = argv[0]; /* * Look up the function in the table that associates function names * with the C functions that implement them. */ for(i=0; iva = va; demo->vb = vb; demo->have_slice = 1; /* * Plot the new slice. */ return demo_display_slice(demo, &va, &vb); } /*....................................................................... * Implement the demo "redraw_slice" command. * * Input: * demo Pgdemo * The demo being serviced. * interp Tcl_Interp * The TCL interpreter of the demo. * argc int The number of TCL arguments in argv[]. * argv char ** An array of 'argc' TCL arguments. No arguments * are expected. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int pgdemo_redraw_slice_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]) { if(argc > 0) { Tcl_AppendResult(interp, "'pgdemo redraw_slice' takes no arguments.", NULL); return TCL_ERROR; }; if(demo->have_slice) demo_display_slice(demo, &demo->va, &demo->vb); else demo_display_help(demo); return TCL_OK; } /*....................................................................... * Implement the demo "recolor_image" command. This takes one of a set of * supported color-table names and redisplays the current image with the * specified color table. * * Input: * demo Pgdemo * The demo being serviced. * interp Tcl_Interp * The TCL interpreter of the demo. * argc int The number of TCL arguments in argv[]. * argv char ** An array of 'argc' TCL arguments. * argv[0] - A color table name chosen from: * "aips" - AIPS tvfiddle color table. * "blue" - A blue color table. * "green" - A green color table. * "grey" - A grey-scale color table. * "heat" - The IRAF "heat" color table. * "rainbow" - A red color table. * "red" - A red color table. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int pgdemo_recolor_image_command(Pgdemo *demo, Tcl_Interp *interp, int argc, char *argv[]) { char *name; /* The name of the desired color table */ int i; /* * There should only be a single argument. */ if(argc != 1) { Tcl_AppendResult(interp, "Missing color-table name.\n", NULL); return TCL_ERROR; }; /* * Get the color-table name. */ name = argv[0]; /* * Look up the name in our list of supported color tables. */ for(i=0; iname, name) == 0) { cpgslct(demo->image_id); cpgctab(cmap->l, cmap->r, cmap->g, cmap->b, cmap->n, 1.0, 0.5); return TCL_OK; }; }; Tcl_AppendResult(interp, "Unknown color map name \"", name, "\"", NULL); return TCL_ERROR; } /*....................................................................... * A sinc(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sinc_fn) { const float tiny = 1.0e-6f; float radius = sqrt(x*x + y*y); return (fabs(radius) < tiny) ? 1.0f : sin(radius)/radius; } /*....................................................................... * A exp(-(x^2+y^2)/20) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(gaus_fn) { return exp(-((x*x)+(y*y))/20.0f); } /*....................................................................... * A cos(radius)*sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(ring_fn) { return cos(sqrt(x*x + y*y)) * sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * A sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sin_angle_fn) { return sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * A cos(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(cos_radius_fn) { return cos(sqrt(x*x + y*y)); } /*....................................................................... * A (1+sin(6*angle))*exp(-radius^2 / 100)function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(star_fn) { return (1.0 + sin(x==0.0f && y==0.0f ? 0.0f : 6.0*atan2(x,y))) * exp(-((x*x)+(y*y))/100.0f); } /*....................................................................... * Display a new function in the image window. * * Input: * demo Pgdemo * The demo instance object. * interp Tcl_Interp * The TCL interpreter of the demo. * fn IMAGE_FN(*) The function to be displayed. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int demo_display_fn(Pgdemo *demo, Tcl_Interp *interp, IMAGE_FN(*fn)) { int ix, iy; /* The pixel coordinates being assigned */ float vmin; /* The minimum pixel value in the image */ float vmax; /* The maximum pixel value in the image */ float *pixel;/* A pointer to pixel (ix,iy) in demo->image */ /* * Check arguments. */ if(!fn) { Tcl_AppendResult(interp, "demo_display_fn: NULL function.", NULL); return TCL_ERROR; }; /* * Install the new function. */ demo->fn = fn; /* * Display a "please wait" message in the slice window. */ demo_display_busy(demo); /* * Fill the image array via the current display function. */ pixel = demo->image; vmin = vmax = demo->fn(demo->xa * demo->scale, demo->ya * demo->scale); for(iy = demo->ya; iy <= demo->yb; iy++) { for(ix = demo->xa; ix <= demo->xb; ix++) { float value = demo->fn(ix * demo->scale, iy * demo->scale); *pixel++ = value; if(value < vmin) vmin = value; if(value > vmax) vmax = value; }; }; /* * Record the min and max values of the data array. */ demo->datamin = vmin; demo->datamax = vmax; /* * Display the new image. */ demo_display_image(demo, demo->image_id); /* * Display instructions in the slice window. */ demo_display_help(demo); /* * No slice has been selected yet. */ demo->have_slice = 0; return TCL_OK; } /*....................................................................... * Display the current image function in a specified PGPLOT device. * * * Input: * demo Pgdemo * The demo instance object. * id int The id of the PGPLOT device to display. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int demo_display_image(Pgdemo *demo, int id) { /* * Select the specified PGPLOT device and display the image array. */ cpgslct(id); cpgask(0); cpgpage(); cpgsch(1.0f); cpgvstd(); cpgwnad(demo->xa * demo->scale, demo->xb * demo->scale, demo->ya * demo->scale, demo->yb * demo->scale); { float tr[6]; /* Coordinate definition matrix */ tr[0] = (demo->xa - 1) * demo->scale; tr[1] = demo->scale; tr[2] = 0.0f; tr[3] = (demo->ya - 1) * demo->scale; tr[4] = 0.0f; tr[5] = demo->scale; if(demo->monochrome) { cpggray(demo->image, demo->image_size, demo->image_size, 1, demo->image_size, 1, demo->image_size, demo->datamax, demo->datamin, tr); } else { cpgimag(demo->image, demo->image_size, demo->image_size, 1, demo->image_size, 1, demo->image_size, demo->datamin, demo->datamax, tr); }; }; cpgsci(1); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("X", "Y", "Image display demo"); return TCL_OK; } /*....................................................................... * Display a new slice in the slice window. * * Input: * demo Pgdemo * The demo instance object. * va Vertex * The vertex of one end of the slice line. * vb Vertex * The vertex of the opposite end of the slice line. * Output: * return int TCL_OK - Normal completion. * TCL_ERROR - The interpreter result will contain * the error message. */ static int demo_display_slice(Pgdemo *demo, Vertex *va, Vertex *vb) { float xa; /* The start X value of the slice */ float dx; /* The X-axis world-coordinate width of one slice pixel */ float ya; /* The start Y value of the slice */ float dy; /* The Y-axis world-coordinate width of one slice pixel */ float smin;/* The minimum slice value */ float smax;/* The maximum slice value */ float slice_length; /* The world-coordinate length of the slice */ float ymargin; /* The Y axis margin within the plot */ int i; /* * Determine the slice pixel assignments. */ xa = va->x; dx = (vb->x - va->x) / demo->slice_size; ya = va->y; dy = (vb->y - va->y) / demo->slice_size; /* * Make sure that the slice has a finite length by setting a * minimum size of one pixel. */ { float min_delta = demo->scale / demo->slice_size; if(fabs(dx) < min_delta && fabs(dy) < min_delta) dx = min_delta; }; /* * Construct the slice in demo->slice[] and keep a tally of the * range of slice values seen. */ for(i=0; islice_size; i++) { float value = demo->fn(xa + i * dx, ya + i * dy); demo->slice[i] = value; if(i==0) { smin = smax = value; } else if(value < smin) { smin = value; } else if(value > smax) { smax = value; }; }; /* * Determine the length of the slice. */ { float xlen = dx * demo->slice_size; float ylen = dy * demo->slice_size; slice_length = sqrt(xlen * xlen + ylen * ylen); }; /* * Determine the extra length to add to the Y axis to prevent the * slice plot hitting the top and bottom of the plot. */ ymargin = 0.05 * (demo->datamax - demo->datamin); /* * Set up the slice axes. */ cpgslct(demo->slice_id); cpgask(0); cpgpage(); cpgbbuf(); cpgsch(2.0f); cpgvstd(); cpgswin(0.0f, slice_length, demo->datamin - ymargin, demo->datamax + ymargin); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("Radius", "Image value", "A 1D slice through the image"); /* * Draw the slice. */ for(i=0; islice_size; i++) { if(i==0) cpgmove(0.0f, demo->slice[0]); else cpgdraw(slice_length * (float)i / (float)demo->slice_size, demo->slice[i]); }; cpgebuf(); return TCL_OK; } /*....................................................................... * Display usage instructions in the slice window. * * Input: * demo Pgdemo * The demo instance object. */ static void demo_display_help(Pgdemo *demo) { /* * Clear the slice plot and replace it with instructional text. */ cpgslct(demo->slice_id); cpgask(0); cpgpage(); cpgsch(3.0f); cpgsvp(0.0, 1.0, 0.0, 1.0); cpgswin(0.0, 1.0, 0.0, 1.0); cpgmtxt("T", -2.0, 0.5, 0.5, "See the help menu for instructions."); } /*....................................................................... * Display a "Please wait" message in the slice window. * * Input: * demo Pgdemo * The demo instance object. */ static void demo_display_busy(Pgdemo *demo) { /* * Clear the slice plot and replace it with instructional text. */ cpgslct(demo->slice_id); cpgask(0); cpgpage(); cpgsch(3.5f); cpgsvp(0.0, 1.0, 0.0, 1.0); cpgswin(0.0, 1.0, 0.0, 1.0); cpgmtxt("T", -2.0, 0.5, 0.5, "Please wait."); } /*....................................................................... * Check that the specified command-line argument names a pgtkdemo * script file. A pgtkdemo script file is defined as being a readable * text file that contains the string "#!pgtkdemo.tcl" at its start. * * Input: * name char * The command-line argument to be checked. * Output: * return int 0 - Not valid. * 1 - Valid. */ static int valid_demo_script(char *name) { #define REQUIRED_HEADER "#!pgtkdemo" char header[sizeof(REQUIRED_HEADER)]; /* * Attempt to open the file for reading. */ FILE *fp = fopen(name, "r"); if(!fp) { fprintf(stderr, "Unable to open file: %s\n", name); return 0; }; /* * Read the first line and compare it to the required header. */ if(fgets(header, sizeof(header), fp) == NULL || strcmp(header, REQUIRED_HEADER)!=0 || getc(fp) != '\n') { fprintf(stderr, "File '%s' is not a pgtkdemo Tcl script.\n", name); fclose(fp); return 0; }; fclose(fp); return 1; } coordinates to evaluate the function at. * Output: * return float The function value at the specipgplot/drivers/xtk/pgtkdemo.tcl010075500040640000322000000404000656367144100173510ustar00tjpcitmbr00000400000017#!pgtkdemo #----------------------------------------------------------------------- # Create an unmapped prompt dialog. # # This is split into a top section and a bottom section. # The top section contains a title and an entry widget $w.top.entry. # The bottom section contains three buttons, $w.bot.ok, $w.bot.cancel # and $w.bot.help. Only the "close" button is assigned a command. # The other buttons should be set by the caller. Note that the help # button is displayed disabled # # Note that the dialog is not initially mapped. To display it temporarily # use the command {wm deiconify $w} and then when it is no longer required # call {wm withdraw $w}. # # Input: # w The name to give the widget. # title The title to give the dialog. # label The message to place above the entry widget. #----------------------------------------------------------------------- proc create_prompt_dialog {w title msg} { # # Create the toplevel dialog window withdrawn. # toplevel $w -class dialog wm withdraw $w wm title $w $title wm iconname $w Dialog # # Create the top and bottom frames. # frame $w.top -relief raised -bd 1 pack $w.top -side top -fill both -expand 1 frame $w.bot -relief raised -bd 1 pack $w.bot -side bottom -fill both -expand 1 # # Create a label and an entry widget in the top frame. # message $w.top.msg -justify left -width 8c -anchor w -text $msg entry $w.top.entry -relief sunken -bd 2 -width 30 pack $w.top.msg $w.top.entry -side top -anchor w # # Create three buttons in the bottom frame. # button $w.bot.ok -text OK button $w.bot.cancel -text Cancel -command "wm withdraw $w" button $w.bot.help -text Help -state disabled pack $w.bot.ok $w.bot.cancel $w.bot.help -side left -expand 1 -pady 2m -padx 2m # # Arrange for carriage-return to invoke the OK key. # bind $w "$w.bot.ok invoke" } #----------------------------------------------------------------------- # Create an unmapped help dialog. # # Note that the dialog is not initially mapped. To display it temporarily # use the command {wm deiconify $w} and then when it is no longer required # call {wm withdraw $w}. # # Input: # w The name to give the widget. # title The dialog title. # text The text to display in the widget. #----------------------------------------------------------------------- proc create_help_dialog {w title text} { # # Create the dialog container and tell the window-manager what to call # both it and its icon. # toplevel $w -class dialog wm withdraw $w wm title $w $title wm iconname $w Dialog # # Create the top-half of the dialog and display display the usage message # in it. # frame $w.top -relief raised -bd 1 message $w.top.msg -width 12c -text $text pack $w.top.msg -side left -expand 1 -fill both # # Create the bottom half of the dialog and place a single OK button in # it. Arrange that pressing the OK button unmaps the dialog. # frame $w.bot -relief raised -bd 1 button $w.bot.ok -text OK -command "wm withdraw $w" pack $w.bot.ok -pady 2m # # Arrange for carriage-return to invoke the OK key. # bind $w "$w.bot.ok invoke" # # Place the widgets in their assigned places top and bottom. # pack $w.top $w.bot -side top -fill both -expand 1 } #----------------------------------------------------------------------- # Create a labelled option menu. # # The name of the menu widget will be $w.menu and the option-menu value # will be maintained in a global variable of name global$w.menu. # # Input: # w The name for the frame-widget that encloses the menu. # label The label to place to the left of the option-menu button. # cmd The command to be called whenever the option-menu value # is changed. This will be called as a "trace variable" # callback, whenever global$w.menu is written to. # name_list The list of option names. #----------------------------------------------------------------------- proc create_option_menu {w label cmd name_list} { # # Create a frame to enclose the menu. # frame $w # # Create the option-menu label. # label $w.label -text $label # # Get the name of the variable this is to be used to trace menu-value # changes. # set var global$w.menu global $var # # Create the option menu. # eval tk_optionMenu $w.menu $var $name_list trace variable $var w $cmd # # Set the width of the menu button to be the maxmimum of all # menu options. This removes the need for dynamic resizing. # set maxwidth 0 foreach name $name_list { set length [string length $name] if [ expr $length > $maxwidth ] { set maxwidth $length } } $w.menu configure -width $maxwidth # # Place the label to the left of the menu button. # pack $w.label $w.menu -side left } #----------------------------------------------------------------------- # Create an unmapped save-image dialog. #----------------------------------------------------------------------- proc create_save_dialog {w} { create_prompt_dialog $w "Save image" "Enter a PGPLOT device string:" $w.bot.ok configure -command "wm withdraw $w;update;save_image_callback $w" } #----------------------------------------------------------------------- # This function is called when the user presses the OK button of the # save-image dialog. # # Input: # w The name of the save dialog. #----------------------------------------------------------------------- proc save_image_callback {w} { pgdemo save [$w.top.entry get] } #----------------------------------------------------------------------- # Draw the currently selected image function. #----------------------------------------------------------------------- proc draw_image {args} { upvar #0 global.function.menu mode_menu # # Display a busy-cursor. # . configure -cursor {watch} .imagearea.pgplot configure -cursor {} update # # Display the new function. # pgdemo function $mode_menu # # Reset the cursor. # . configure -cursor {} .imagearea.pgplot configure -cursor {crosshair black white} update # # Arm the cursor of the image window for the selection of a slice. # prepare_for_slice } #----------------------------------------------------------------------- # Recolor the current image. #----------------------------------------------------------------------- proc recolor_image {args} { upvar #0 global.colors.menu color_menu # # Change the colors. # pgdemo recolor_image $color_menu # # Redraw the current image if necessary. # if [.imagearea.pgplot cget -share] { draw_image } } #----------------------------------------------------------------------- # Arm the image-widget cursor such that when the user next presses a # mouse button or key within the image window the start of a slice # will be selected. #----------------------------------------------------------------------- proc prepare_for_slice {args} { .imagearea.pgplot setcursor norm 0.0 0.0 1 bind .imagearea.pgplot {start_slice %x %y} } #----------------------------------------------------------------------- # This is used as a pgplot image-widget cursor callback. It augments the # cursor in the image window with a line rubber-band anchored at the # selected cursor position and registers a new callback to receive both # the current coordinates and coordinates of the end of the slice when # selected. # # Input: # wx wy The X-window coordinates of the position that the user selected # with the cursor. #----------------------------------------------------------------------- proc start_slice {wx wy} { set pg .imagearea.pgplot # # Convert from X coordinates to world coordinates. # set x [$pg world x $wx] set y [$pg world y $wy] $pg setcursor line $x $y 3 bind $pg "end_slice $x $y %x %y" } #----------------------------------------------------------------------- # This image-window pgplot-cursor callback is registered by start_slice. # It receives the start coordinates of a slice from start_slice and # the coordinate of the end of the slice from the callback arguments # provided by the pgplot widget. # # Input: # x1 y1 The coordinate of the start of the slice in the image # window. These values were supplied when the callback # was registered by start_slice. # wx2 wy2 The X-window coordinate of the end of the slice. #----------------------------------------------------------------------- proc end_slice {x1 y1 wx2 wy2} { set pg .imagearea.pgplot prepare_for_slice pgdemo slice $x1 $y1 [$pg world x $wx2] [$pg world y $wy2] } #----------------------------------------------------------------------- # This procedure creates the main menubar of the application. # # Input: # w The name to give the widget. #----------------------------------------------------------------------- proc create_main_menubar {w} { # # Create a raised frame for the menubar. # frame $w -relief raised -bd 2 -width 11c # # Create the file menu. # menubutton $w.file -text File -menu $w.file.menu menu $w.file.menu -tearoff 0 $w.file.menu add command -label {Save image as} -command { wm deiconify .save raise .save } $w.file.menu add separator $w.file.menu add command -label {Quit} -command {exit} # # Arrange that Alt-Q will abort the application. # bind all {exit} # # Create the help menu. # menubutton $w.help -text Help -menu $w.help.menu menu $w.help.menu -tearoff 0 $w.help.menu add command -label {Usage} -command { wm deiconify .usage_help raise .usage_help } # # Pack all but the help menu at the left side of the menubar. # pack $w.file -side left # # Pack the help menu against the right edge of the menubar, as specified # by the Motif style guide. # pack $w.help -side right } #----------------------------------------------------------------------- # Create an area in which to display the world coordinates of the cursor # when it is over the image window. # # Input: # w The name to give the frame widget that encloses the area. #----------------------------------------------------------------------- proc create_world_labels {w} { # # Enclose the area in a frame. # frame $w -width 11c -height 1c # # Create a static title label. # label $w.title -text "World coordinates: " # # Create the X and Y labels for displaying the respective coordinates. # label $w.x -width 12 -anchor w label $w.y -width 12 -anchor w pack $w.title -side left -anchor w pack $w.x $w.y -side left -anchor w -padx 2m } #----------------------------------------------------------------------- # Create the area that contains the image PGPLOT window. # # Input: # w The name to give the frame widget that encloses the area. #----------------------------------------------------------------------- proc create_image_area {w} { # # Frame the workarea. # frame $w -width 11c -height 11c # # Create the PGPLOT image window. # pgplot $w.pgplot -share true -width 10c -height 10c -mincolors 25 -maxcolors 64 -bd 2 -bg black -fg white # # Create horizontal and vertical scroll-bars and have them # call the pgplot xview and yview scroll commands to scroll the # image within the window. # scrollbar $w.xscroll -command "$w.pgplot xview" -orient horizontal scrollbar $w.yscroll -command "$w.pgplot yview" -orient vertical # # Tell the PGPLOT widget how to update the scrollbar sliders. # $w.pgplot configure -xscrollcommand "$w.xscroll set" $w.pgplot configure -yscrollcommand "$w.yscroll set" # # Position the PGPLOT widget and the scrollbars. # pack $w.xscroll -side bottom -fill x pack $w.yscroll -side right -fill y pack $w.pgplot -side left -fill both -expand true # # Bind motion events to the world coordinate x and y label widgets. # bind .imagearea.pgplot {report_motion %W %x %y} } #----------------------------------------------------------------------- # This procedure is called whenever cursor motion is detected in the # the image widget. It displays the world coordinates of the cursor # in previously created label widgets. # # Input: # pg The image pgplot widget. # x y The X-window coordinates of the cursor. #----------------------------------------------------------------------- proc report_motion {pg x y} { global tcl_precision set tcl_precision 3 .world.x configure -text "X=[$pg world x $x]" .world.y configure -text "Y=[$pg world y $y]" set tcl_precision 6 } #----------------------------------------------------------------------- # Create the area that contains the slice PGPLOT window. # # Input: # w The name to give the frame widget that encloses the area. #----------------------------------------------------------------------- proc create_slice_area {w} { # # Frame the workarea. # frame $w -width 11c -height 6c # # Create the PGPLOT slice window. # pgplot $w.pgplot -share true -width 10c -height 5c -maxcolors 2 -bd 2 -bg black -fg white # # Position the PGPLOT widget. # pack $w.pgplot -side left -fill both -expand true # # Arrange for the plot to be redrawn whenever the widget is resized. # bind $w.pgplot {pgdemo redraw_slice} } #----------------------------------------------------------------------- # This is the main procedure of this script. #----------------------------------------------------------------------- # Set the title of the application window and its icon. wm title . "Pgtkdemo" wm iconname . "Pgtkdemo" # Prevent other applications from sending commands to this one! rename send {} # Override selected widget defaults. option add *font -Adobe-Times-Medium-R-Normal-*-140-* widgetDefault # Set default widget colors. set bg "#bfe5ff" set alt_bg "#00ddff" . configure -bg $bg option add *background $bg widgetDefault option add *activeBackground $bg widgetDefault option add *activeForeground blue widgetDefault option add *highlightBackground $bg widgetDefault option add *troughColor $bg widgetDefault option add *Scrollbar.width 3m widgetDefault option add *Scrollbar.background $alt_bg widgetDefault option add *Scrollbar*Foreground $alt_bg widgetDefault option add *Button*Background $alt_bg widgetDefault option add *Button*activeBackground $alt_bg widgetDefault option add *Button*activeForeground black widgetDefault option add *Menubutton*activeForeground black widgetDefault # If the user uses a window-manager function to kill the demo # arrange for the demo to exit quietly. wm protocol . WM_DELETE_WINDOW {exit} # Create the menu-bar. create_main_menubar .menubar # Create label widgets for use in displaying image world coordinates. create_world_labels .world # Create a PGPLOT window with scroll bars, and enclose them in a frame. # This is the image window. create_image_area .imagearea # # Create the function-selection option menu. # create_option_menu .function "Select a display function:" draw_image { "cos(R)sin(A)" "sinc(R)" "exp(-R^2/20.0)" "sin(A)" "cos(R)" "(1+sin(6A))exp(-R^2/100)" } # # Create the colormap-selection option menu. # create_option_menu .colors "Select a color table:" recolor_image { grey rainbow heat aips } # Create a PGPLOT window with scroll bars, and enclose them in a frame. # This is the slice window. create_slice_area .slicearea # Create dialogs for later display. create_save_dialog .save create_help_dialog .usage_help {Usage information} { To see a slice through the displayed image, move the mouse into the image display window and use any mouse button to select the two end points of a line. To display a different image select a new image function from the "Select a display function" option menu. } # Place the menubar at the top of the main window and the work-areas # underneath it. pack .menubar -side top -fill x pack .world -side top -anchor w pack .imagearea -side top -fill both -expand true pack .function -side top -fill x pack .colors -side top -fill x pack .slicearea -side top -fill both -expand true # Create the pgdemo command. create_pgdemo pgdemo [.imagearea.pgplot device] [.slicearea.pgplot device] # Windows in Tk do not take on their final sizes until the whole # application has been mapped. This makes it impossible for the # PGPLOT widget to correctly guess what size of pixmap to allocate # when it starts the first page. To avoid this problem, force Tk # to create all of the windows before drawing the first plot. update idletasks # Draw the initial image. draw_image -------------------- proc recolor_image {args} { upvar #0 global.colors.menu color_menu # # Change the colors. # pgdemo recolor_image $color_menu # # Redraw the current image if necessary. # if [.imagearea.pgplot cget -share] { draw_image } }pgplot/drivers/xtk/tkpgplot.c010064400040640000322000002434530721555577400170620ustar00tjpcitmbr00000400000017#include #include #include #include #include #include #ifdef USE_RIVET #include "rvpgplot.h" /* This includes rivet.h (which includes tcl.h & tk.h) */ #else #include #include "tkpgplot.h" /* This includes tcl.h */ #endif #include "pgxwin.h" /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Compose the pgplot-callable driver function name. * Allow tkdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call tkdriv() or tkdriv_(). */ #ifdef PG_PPU #ifdef RIVET #define DRIV rvdriv_ /* Rivet with PG_PPU defined */ #else #define DRIV tkdriv_ /* Normal Tk with PG_PPU defined */ #endif #else #ifdef RIVET #define DRIV rvdriv /* Rivet with PG_PPU undefined */ #else #define DRIV tkdriv /* Normal Tk with PG_PPU undefined */ #endif #endif /* * List widget defaults. Note that the macros that are prefixed * TKPG_STR_ are for use in the configSpecs resource database. These * have to be strings. */ #define TKPG_MIN_WIDTH 64 /* Minimum width (pixels) */ #define TKPG_MIN_HEIGHT 64 /* Minimum height (pixels) */ #define TKPG_DEF_WIDTH 256 /* Default width (pixels) */ #define TKPG_STR_DEF_WIDTH "256" /* String version of TKPG_DEF_WIDTH */ #define TKPG_DEF_HEIGHT 256 /* Default height (pixels) */ #define TKPG_STR_DEF_HEIGHT "256" /* String version of TKPG_DEF_HEIGHT */ #define TKPG_MIN_COLORS 2 /* Min number of colors per colormap */ #define TKPG_STR_MIN_COLORS "2" /* String version of TKPG_MIN_COLORS */ #define TKPG_DEF_COLORS 100 /* Default number of colors to try for */ #define TKPG_STR_DEF_COLORS "100" /* String version of TKPG_DEF_COLORS */ #define TKPG_MAX_COLORS 255 /* Max number of colors per colormap */ #define TKPG_DEF_HIGHLIGHT_WIDTH 2 /* Default width of traversal highlight */ #define TKPG_STR_DEF_HIGHLIGHT_WIDTH "2"/* String ver of TKPG_DEF_HIGHLIGHT_WIDTH */ #define TKPG_STR_MARGIN_DEF "20" /* The default number of pixels of */ /* extra space to allocate around the */ /* edge of the plot area. */ /* * Specify the name to prefix errors with. */ #define TKPG_IDENT "PgplotWidget" typedef struct TkPgplot TkPgplot; /* * Declare a container for a list of PGPLOT widgets. */ typedef struct { TkPgplot *head; /* The head of the list of widgets */ } TkPgplotList; /* * A context descriptor for managing parent ScrolledWindow scroll-bars. */ typedef struct { #ifdef RIVET Callback xScrollCmd; /* Rivet X-axis update-scrollbar callback */ Callback yScrollCmd; /* Rivet Y-axis update-scrollbar callback */ #else char *xScrollCmd; /* Tcl X-axis scrollbar-update command */ char *yScrollCmd; /* Tcl Y-axis scrollbar-update command */ #endif unsigned x; /* Pixmap X coordinate of top left corner of window */ unsigned y; /* Pixmap Y coordinate of top left corner of window */ } TkpgScroll; /* * This container records state-values that are modified by X events. */ typedef struct { unsigned long mask; /* Event mask registered to tkpg_EventHandler() */ int focus_acquired; /* True when we have keyboard-input focus */ int cursor_active; /* True when cursor augmentation is active */ } TkpgEvents; struct TkPgplot { #ifdef RIVET RIVET_CLASS_DECL #endif /* Widget context */ Tk_Window tkwin; /* Tk's window object */ Display *display; /* The X display of the window */ Tcl_Interp *interp; /* The application's TCL interpreter */ char buffer[81]; /* A work buffer for constructing result strings */ /* Public resource attributes */ int max_colors; /* The max number of colors needed */ int min_colors; /* The min number of colors needed */ int req_width; /* The requested widget width (pixels) */ int req_height; /* The requested widget height (pixels) */ int highlight_thickness; /* The width of the highlight border */ XColor *highlightBgColor; /* The inactive traversal highlight color */ XColor *highlightColor; /* The active traversal highlight color */ XColor *normalFg; /* Normal foreground color (color index 1) */ Tk_3DBorder border; /* 3D border structure */ int borderWidth; /* The width of the 3D border */ int relief; /* Relief of the 3D border */ char *takeFocus; /* "1" to allow focus traversal, "0" to disallow */ Cursor cursor; /* The active cursor of the window */ int share; /* True if shared colors are desired */ int padx,pady; /* Extra padding margin widths (pixels) */ /* Private attributes */ TkPgplot *next; /* The next widget of a list of PGPLOT Xt widgets */ int tkslct_id; /* The device ID returned to PGPLOT by the */ /* open-workstation driver opcode, and used for */ /* subsequent device selection via the */ /* select-plot driver opcode */ int pgslct_id; /* The device ID returned to the application by */ /* pgopen() for subsequent device selection with */ /* the pgslct() function */ char *device; /* A possible PGPLOT cpgbeg() file string */ TkpgScroll scroll; /* Used to maintain parent scroll bars */ TkpgEvents events; /* X event context */ PgxWin *pgx; /* PGPLOT generic X-window context descriptor */ }; static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name, int argc, char *argv[]); static TkPgplot *del_TkPgplot(TkPgplot *tkpg); /* * Describe all recognized widget resources. */ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_BORDER, "-background", "background", "Background", "Black", Tk_Offset(TkPgplot, border), 0}, {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", "White", Tk_Offset(TkPgplot, normalFg), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", "", Tk_Offset(TkPgplot, cursor), TK_CONFIG_NULL_OK}, {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", "0", Tk_Offset(TkPgplot, borderWidth), 0}, {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "raised", Tk_Offset(TkPgplot, relief), 0}, {TK_CONFIG_PIXELS, "-height", "height", "Height", TKPG_STR_DEF_HEIGHT, Tk_Offset(TkPgplot, req_height), 0}, {TK_CONFIG_PIXELS, "-width", "width", "Width", TKPG_STR_DEF_WIDTH, Tk_Offset(TkPgplot, req_width), 0}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", "grey", Tk_Offset(TkPgplot, highlightBgColor), 0}, {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", "White", Tk_Offset(TkPgplot, highlightColor), 0}, {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", TKPG_STR_DEF_HIGHLIGHT_WIDTH, Tk_Offset(TkPgplot, highlight_thickness), 0}, {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", "0", Tk_Offset(TkPgplot, takeFocus), TK_CONFIG_NULL_OK}, #ifdef RIVET {TK_CONFIG_CUSTOM, "-xscrollcommand", "xScrollCommand", "ScrollCommand", 0, Tk_Offset(TkPgplot, scroll.xScrollCmd), TK_CONFIG_NULL_OK, &rivet_custom_callback_option}, #else {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", "", Tk_Offset(TkPgplot, scroll.xScrollCmd), TK_CONFIG_NULL_OK}, #endif #ifdef RIVET {TK_CONFIG_CUSTOM, "-yscrollcommand", "yScrollCommand", "ScrollCommand", 0, Tk_Offset(TkPgplot, scroll.yScrollCmd), TK_CONFIG_NULL_OK, &rivet_custom_callback_option}, #else {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", "", Tk_Offset(TkPgplot, scroll.yScrollCmd), TK_CONFIG_NULL_OK}, #endif {TK_CONFIG_INT, "-mincolors", "minColors", "MinColors", TKPG_STR_MIN_COLORS, Tk_Offset(TkPgplot, min_colors), 0}, {TK_CONFIG_INT, "-maxcolors", "maxColors", "MaxColors", TKPG_STR_DEF_COLORS, Tk_Offset(TkPgplot, max_colors), 0}, {TK_CONFIG_BOOLEAN, "-share", "share", "Share", 0, Tk_Offset(TkPgplot, share), 0}, {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, padx), 0}, {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, pady), 0}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* Enumerate the PGPLOT class widget lists */ #define TKPG_ACTIVE_WIDGETS 1 #define TKPG_FREE_WIDGETS 2 static TkPgplotList *tkpg_WidgetList(int type); static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev); static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev); static TkPgplot *tkpg_RemoveWidget(char *name, int type); static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type); static TkPgplot *tkpg_CurrentWidget(char *context); static TkPgplot *tkpg_open_widget(char *name); static TkPgplot *tkpg_close_widget(char *name); static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height); static void tkpg_update_scroll_bars(TkPgplot *tkpg); static void tkpg_update_clip(TkPgplot *tkpg); static void tkpg_update_border(TkPgplot *tkpg); static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_InstanceCommand_return(ClientData context, int iret); static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[], int flags); static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event); static void tkpg_draw_focus_highlight(TkPgplot *tkpg); static void tkpg_draw_3d_border(TkPgplot *tkpg); static int tkpg_refresh_window(TkPgplot *tkpg); static void tkpg_ClrCursor(TkPgplot *tkpg); static void tkpg_EventHandler(ClientData context, XEvent *event); static void tkpg_CursorHandler(ClientData context, XEvent *event); static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w, char *path); /* * Enumerate supported pgband() cursor types. */ typedef enum { TKPG_NORM_CURSOR = 0, /* Un-augmented X cursor */ TKPG_LINE_CURSOR = 1, /* Line cursor between ref and pointer */ TKPG_RECT_CURSOR = 2, /* Rectangular cursor between ref and pointer */ TKPG_YRNG_CURSOR = 3, /* Two horizontal lines, at ref.x and pointer.x */ TKPG_XRNG_CURSOR = 4, /* Two vertical lines, at ref.y and pointer.y */ TKPG_HLINE_CURSOR = 6, /* Horizontal line cursor at y=ref.y */ TKPG_VLINE_CURSOR = 5, /* Vertical line cursor at x=ref.x */ TKPG_CROSS_CURSOR = 7 /* Cross-hair cursor centered on the pointer */ } TkpgCursorMode; static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode, float xref, float yref, int ci); #ifdef RIVET static void tkpg_FreeProc(ClientData context); #else static void tkpg_FreeProc(char *context); #endif static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]); static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]); static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); #ifdef RIVET static void del_RvPgplot(ClientData obj); static Rivet_class_struct PgplotClassObj = { 0, "Pgplot", PgplotCmd, tkpg_InstanceCommand, del_RvPgplot, 0, configSpecs, 0, }; Rivetclass PgplotClass = &PgplotClassObj; #endif /* * The following file-scope container records the list of active and * inactive PGPLOT widgets. */ static struct { int id_counter; /* Used to give widgets unique identifiers */ TkPgplotList active_widgets; /* List of active widgets */ TkPgplotList free_widgets; /* List of unnassigned widgets */ } tkPgplotClassRec = { 0, /* id_counter */ {NULL}, /* active_widgets */ {NULL}, /* free_widgets */ }; /* * The following macro defines the event mask used by the cursor event * handler. It is here to ensure that Tk_CreateEventHandler() and * Tk_DeleteEventHandler() are presented with identical event masks. */ #define CURSOR_EVENT_MASK ((unsigned long)(EnterWindowMask | LeaveWindowMask | \ PointerMotionMask)) /* * The following macro defines the event mask normally used by the widget. */ #define NORMAL_EVENT_MASK ((unsigned long)(StructureNotifyMask | \ ExposureMask | FocusChangeMask)) /*....................................................................... * Provide a package initialization procedure. This creates the Tcl * "pgplot" widget creation command. * * Input: * interp Tcl_Interp * The TCL interpreter of the application. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ #ifdef RIVET int Rvpgplot_Init(Tcl_Interp *interp) #else int Tkpgplot_Init(Tcl_Interp *interp) #endif { /* * Get the main window of the application. */ Tk_Window main_w = Tk_MainWindow(interp); /* * If Tk_Init() hasn't been called, then there won't be a main window * yet. In such cases, Tk_MainWindow() places a suitable error message * in interp->result. */ if(!main_w) return TCL_ERROR; /* * Create the TCL command that is to be used for creating PGPLOT widgets. */ Tcl_CreateCommand(interp, "pgplot", PgplotCmd, (ClientData) main_w, 0); return TCL_OK; } /*....................................................................... * This function provides the TCL command that creates a PGPLOT widget. * * Input: * context ClientData The client_data argument specified in * TkPgplot_Init() when PgplotCmd was registered. * This is the main window cast to (ClientData). * interp Tcl_Interp * The TCL intrepreter. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * argv[0] = "pgplot" * argv[1] = the name to give the new widget. * argv[2..argc-1] = attribute settings. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc, char *argv[]) { Tk_Window main_tkw = (Tk_Window)context; /* The application main window */ TkPgplot *tkpg; /* The new widget instance object */ /* * Make sure that a name for the new widget has been provided. */ if(argc < 2) { Tcl_AppendResult(interp, "Wrong number of arguments - should be \'", argv[0], " pathName \?options\?\'", NULL); return TCL_ERROR; }; /* * Allocate the widget-instance object. */ tkpg = new_TkPgplot(interp, main_tkw, argv[1], argc-2, argv+2); if(!tkpg) return TCL_ERROR; return TCL_OK; } /*....................................................................... * Create a new widget instance object. * * Input: * interp Tcl_Interp * The TCL interpreter object. * main_w Tk_Window The main window of the application. * name char * The name to give the new widget. * argc int The number of argument in argv[] * argv char ** Any configuration arguments. * Output: * return TkPgplot * The new PGPLOT widget, or NULL on error. * If NULL is returned then the context of the * error will have been recorded in the result * field of the interpreter. */ static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name, int argc, char *argv[]) { TkPgplot *tkpg; /* The new widget object */ PgxWin *pgx; /* The PGPLOT X window object of the widget */ Tk_Window top_w; /* The top-level window parent of 'name' */ /* * Get the toplevel window associated with the pathname in 'name'. */ top_w = tkpg_toplevel_of_path(interp, main_w, name); if(!top_w) return NULL; /* * Allocate the container. */ tkpg = (TkPgplot *) malloc(sizeof(TkPgplot)); if(!tkpg) { Tcl_AppendResult(interp, "Insufficient memory to create ", name, NULL); return NULL; }; /* * Before attempting any operation that might fail, initialize the container * at least up to the point at which it can safely be passed to * del_TkPgplot(). */ tkpg->tkwin = NULL; tkpg->display = Tk_Display(main_w); tkpg->interp = interp; tkpg->max_colors = TKPG_DEF_COLORS; tkpg->min_colors = TKPG_MIN_COLORS; tkpg->req_width = TKPG_DEF_WIDTH; tkpg->req_height = TKPG_DEF_HEIGHT; tkpg->highlight_thickness = TKPG_DEF_HIGHLIGHT_WIDTH; tkpg->highlightBgColor = NULL; tkpg->highlightColor = NULL; tkpg->normalFg = NULL; tkpg->border = NULL; tkpg->borderWidth = 0; tkpg->relief = TK_RELIEF_RAISED; tkpg->takeFocus = NULL; tkpg->cursor = None; tkpg->share = 0; tkpg->padx = 0; tkpg->pady = 0; tkpg->next = NULL; tkpg->tkslct_id = tkPgplotClassRec.id_counter++; tkpg->pgslct_id = 0; tkpg->device = NULL; tkpg->scroll.xScrollCmd = NULL; tkpg->scroll.yScrollCmd = NULL; tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg->events.mask = NoEventMask; tkpg->events.focus_acquired = 0; tkpg->events.cursor_active = 0; tkpg->pgx = NULL; /* * Allocate the PGPLOT-window context descriptor. */ pgx = tkpg->pgx = new_PgxWin(tkpg->display, Tk_ScreenNumber(top_w), (void *) tkpg, name, 0, tkpg_NewPixmap); if(!pgx) { Tcl_AppendResult(interp, "Unable to create Pgplot window object for: ", name, NULL); return NULL; }; /* * Compose a sample PGPLOT device-specification for use in opening this * widget to PGPLOT. */ tkpg->device = (char *) malloc(sizeof(char) * (strlen(name)+1+strlen(TK_PGPLOT_DEVICE)+1)); if(!tkpg->device) { Tcl_AppendResult(interp, "Insufficient memory for ", name, NULL); return NULL; }; sprintf(tkpg->device, "%s/%s", name, TK_PGPLOT_DEVICE); /* * Ensure that the toplevel window parent of the new window exists, * before attempting to determine its visual. */ Tk_MakeWindowExist(top_w); /* * Create the widget window from the specified path. */ tkpg->tkwin = Tk_CreateWindowFromPath(interp, main_w, name, NULL); if(!tkpg->tkwin) return del_TkPgplot(tkpg); /* * Give the widget a class name. */ Tk_SetClass(tkpg->tkwin, "Pgplot"); /* * Register an event handler. */ tkpg->events.mask = NORMAL_EVENT_MASK; Tk_CreateEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); /* * Create the TCL command that will allow users to configure the widget. */ Tcl_CreateCommand(interp, name, tkpg_InstanceCommand, (ClientData) tkpg, 0); /* * Parse command line defaults into tkpg so that tkpg->min_colors, * tkpg->max_colors and tkpg->share are known. */ if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv, (char *) tkpg, 0) == TCL_ERROR) return del_TkPgplot(tkpg); /* * If requested, try to allocate read/write colors. * If this fails arrange to try shared colors. */ if(!tkpg->share && !pgx_window_visual(pgx, Tk_WindowId(top_w), tkpg->min_colors, tkpg->max_colors, 0)) tkpg->share = 1; /* * Allocate shared colors? */ if(tkpg->share) { if(!pgx_window_visual(pgx, Tk_WindowId(top_w), tkpg->min_colors, tkpg->max_colors, 1)) { Tcl_AppendResult(interp, "Unable to allocate any colors for ",name,NULL); return del_TkPgplot(tkpg); }; }; /* * Force Tk to create the window. */ Tk_MakeWindowExist(tkpg->tkwin); /* * Fill in details about the window in pgx. */ pgx->window = Tk_WindowId(tkpg->tkwin); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ { XGCValues gcv; gcv.graphics_exposures = False; pgx_start_error_watch(pgx); pgx->expose_gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCGraphicsExposures), &gcv); if(pgx_end_error_watch(pgx) || pgx->expose_gc==NULL) { Tcl_AppendResult(interp, "Failed to allocate a graphical context for ", name, NULL); return del_TkPgplot(tkpg); }; }; /* * Parse the command-line arguments again and install the relevant * defaults into the color descriptor created by pgx_window_visual(). */ if(tkpg_Configure(tkpg, interp, argc, argv, 0)) return del_TkPgplot(tkpg); /* * If the widget has scroll-bars make sure that they agree with the * window. */ tkpg_update_scroll_bars(tkpg); tkpg_update_clip(tkpg); /* * Replace the share configuration attribute with the actual * value that was acheived. */ tkpg->share = pgx->color->readonly; /* * Prepend the new widget to the list of unassigned widgets to be * used by pgbeg(). */ tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS); /* * Return the widget name. */ Tcl_SetResult(interp, Tk_PathName(tkpg->tkwin), TCL_STATIC); return tkpg; } /*....................................................................... * Delete a TkPgplot widget. * * Input: * tkpg TkPgplot * The widget to be deleted. * Output: * return TkPgplot * Always NULL. */ static TkPgplot *del_TkPgplot(TkPgplot *tkpg) { if(tkpg) { if(tkpg->pgx) { PgxWin *pgx = tkpg->pgx; /* * Remove the device from the appropriate list of PGPLOT widgets. */ tkpg_RemoveWidget(pgx->name, pgx->state ? TKPG_ACTIVE_WIDGETS : TKPG_FREE_WIDGETS); /* * Delete the Tcl command attached to the widget. */ Tcl_DeleteCommand(tkpg->interp, pgx->name); /* * Delete the window context descriptor. */ tkpg->pgx = del_PgxWin(tkpg->pgx); }; /* * Delete the device name string. */ if(tkpg->device) free(tkpg->device); tkpg->device = NULL; /* * Clear the cursor. */ tkpg_ClrCursor(tkpg); /* * Delete resource values. */ if(tkpg->display) Tk_FreeOptions(configSpecs, (char *) tkpg, tkpg->display, 0); /* * Remove the DestroyNotify event handler before destroying the * window. Otherwise this function would call itself recursively * and pgx would be free'd twice. */ if(tkpg->events.mask != NoEventMask) { Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); tkpg->events.mask = NoEventMask; }; /* * Zap the window. */ if(tkpg->tkwin) { Tk_DestroyWindow(tkpg->tkwin); tkpg->tkwin = NULL; }; /* * Delete the container. */ free(tkpg); }; return NULL; } #ifdef RIVET /*....................................................................... * This is a rivet-friendly wrapper around del_TkPgplot(). */ static void del_RvPgplot(ClientData obj) { del_TkPgplot((TkPgplot *) obj); } #endif /*....................................................................... * This function is called upon by the pgxwin toolkit whenever the * pixmap used as backing store needs to be resized. * * Input: * pgx PgxWin * The pgxwin toolkit context descriptor. * width unsigned The desired new pixmap width. * height unsigned The desired new pixmap height. */ static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height) { TkPgplot *tkpg = (TkPgplot *) pgx->context; /* * Reset the scrollbars then hand the job of allocating the * pixmap back to the pgxwin toolkit. */ tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg_update_scroll_bars(tkpg); pgx_new_pixmap(pgx, width, height); return; } /*....................................................................... * Whenever the size of a pixmap and/or window of a PGPLOT winget are * changed, this function should be called to adjust scroll bars. * * Input: * tkpg TkPgplot * The pgplot widget instance. */ static void tkpg_update_scroll_bars(TkPgplot *tkpg) { TkpgScroll *scroll = &tkpg->scroll; #ifndef RIVET char scroll_args[60]; /* Scrollbar set-command arguments */ #endif /* * Block widget deletion, so that if one of the scroll-bar callbacks * deletes the widget we won't end up using a deleted tkpg pointer. */ Tk_Preserve((ClientData)tkpg); /* * Update the horizontal scroll-bar if there is one. */ if(scroll->xScrollCmd) { double pixmap_width = pgx_pixmap_width(tkpg->pgx); double first, last; if(pixmap_width < 1.0) { first = 0.0; last = 1.0; } else { first = scroll->x / pixmap_width; last = (scroll->x + Tk_Width(tkpg->tkwin)) / pixmap_width; }; #ifdef RIVET rivet_scrollbar_update((Rivetobj)tkpg, scroll->xScrollCmd, first, last); #else sprintf(scroll_args, " %f %f", first, last); (void) Tcl_VarEval(tkpg->interp, scroll->xScrollCmd, scroll_args, NULL); #endif }; /* * Update the vertical scroll-bar if there is one. */ if(scroll->yScrollCmd) { double pixmap_height = pgx_pixmap_height(tkpg->pgx); double first, last; if(pixmap_height < 1.0) { first = 0.0; last = 1.0; } else { first = scroll->y / pixmap_height; last = (scroll->y + Tk_Height(tkpg->tkwin)) / pixmap_height; }; #ifdef RIVET rivet_scrollbar_update((Rivetobj)tkpg, scroll->yScrollCmd, first, last); #else sprintf(scroll_args, " %f %f", first, last); (void) Tcl_VarEval(tkpg->interp, scroll->yScrollCmd, scroll_args, NULL); #endif }; /* * Tell pgplot about the current scroll and pan values. */ pgx_scroll(tkpg->pgx, scroll->x, scroll->y); /* * Unblock widget deletion. */ Tk_Release((ClientData)tkpg); return; } /*....................................................................... * Update the clip-area of the window to prevent pgxwin functions from * drawing over the highlight-borders. * * Input: * tkpg TkPgplot * The pgplot widget instance. */ static void tkpg_update_clip(TkPgplot *tkpg) { (void) pgx_update_clip(tkpg->pgx, 1, Tk_Width(tkpg->tkwin), Tk_Height(tkpg->tkwin), tkpg->highlight_thickness + tkpg->borderWidth); } /*....................................................................... * Find an inactive PGPLOT widget of a given name, open it to PGPLOT, * and move it to the head of the active list of widgets. * * Input: * name char * The name of the widget to be opened. * Output: * tkpg TkPgplot * The selected widget, or NULL on error. */ static TkPgplot *tkpg_open_widget(char *name) { TkPgplot *tkpg; /* * Remove the named widget from the free-widget list. */ tkpg = tkpg_RemoveWidget(name, TKPG_FREE_WIDGETS); if(!tkpg) { if(tkpg_FindWidgetByName(name, TKPG_ACTIVE_WIDGETS, NULL)) { fprintf(stderr, "%s: Widget %s is already open.\n", TKPG_IDENT, name); } else { fprintf(stderr, "%s: Can't open non-existent widget (%s).\n", TKPG_IDENT, name ? name : "(null)"); }; return NULL; }; /* * Pre-pend the widget to the active list. */ tkpg_PrependWidget(tkpg, TKPG_ACTIVE_WIDGETS); /* * Open the connection to the PgxWin library. */ pgx_open(tkpg->pgx); if(!tkpg->pgx->state) tkpg_close_widget(name); /* * Reset the background and foreground colors to match the current * configuration options. */ pgx_set_background(tkpg->pgx, Tk_3DBorderColor(tkpg->border)); pgx_set_foreground(tkpg->pgx, tkpg->normalFg); /* * Reset its scroll-bars. */ tkpg_update_scroll_bars(tkpg); return tkpg; } /*....................................................................... * Find an active PGPLOT widget of a given name, close it to PGPLOT and * move it to the head of the inactive list of widgets. * * Input: * name char * The name of the widget. * Output: * return TkPgplot * The selected widget, or NULL if not found. */ static TkPgplot *tkpg_close_widget(char *name) { TkPgplot *tkpg; /* * Remove the widget from the active list. */ tkpg = tkpg_RemoveWidget(name, TKPG_ACTIVE_WIDGETS); if(!tkpg) { fprintf(stderr, "%s: Request to close non-existent widget (%s).\n", TKPG_IDENT, name ? name : "(null)"); return NULL; }; /* * Remove cursor handler. */ tkpg_ClrCursor(tkpg); /* * Close the connection to the PgxWin library. */ pgx_close(tkpg->pgx); /* * Invalidate the pgslct() id. The next time that the widget is opened * to PGPLOT a different value will likely be used. */ tkpg->pgslct_id = 0; /* * Prepend the widget to the free list. */ tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS); return tkpg; } /*....................................................................... * Lookup a widget by name from a given list of widgets. * * Input: * name char * The name of the widget. * type int The enumerated name of the list to search, * from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * prev TkPgplot ** *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return TkPgplot * The located widget, or NULL if not found. */ static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev) { TkPgplotList *widget_list; /* The list to be searched */ widget_list = tkpg_WidgetList(type); if(widget_list && name) { TkPgplot *last = NULL; TkPgplot *node = widget_list->head; for( ; node; last = node, node = node->next) { if(strcmp(node->pgx->name, name)==0) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup a widget by its PGPLOT id from a given list of widgets. * * Input: * tkslct_id int The number used by PGPLOT to select the * device. * type int The enumerated name of the list to search, * from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * prev TkPgplot ** *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return TkPgplot * The located widget, or NULL if not found. */ static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev) { TkPgplotList *widget_list; /* The list to be searched */ widget_list = tkpg_WidgetList(type); if(widget_list) { TkPgplot *last = NULL; TkPgplot *node = widget_list->head; for( ; node; last = node, node = node->next) { if(tkslct_id == node->tkslct_id) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup one of the PGPLOT class widget lists by its enumerated type. * * Input: * type int The enumerated name of the list, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplotList * The widget list, or NULL if not recognized. */ static TkPgplotList *tkpg_WidgetList(int type) { switch(type) { case TKPG_ACTIVE_WIDGETS: return &tkPgplotClassRec.active_widgets; case TKPG_FREE_WIDGETS: return &tkPgplotClassRec.free_widgets; default: fprintf(stderr, "tkpg_WidgetList: No such list.\n"); }; return NULL; } /*....................................................................... * Remove a given widget from one of the PGPLOT class widget lists. * * Input: * name char * The name of the widget to be removed from * the list. * type int The enumerated name of the list from which to * remove the widget, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplot * The removed widget, or NULL if not found. */ static TkPgplot *tkpg_RemoveWidget(char *name, int type) { TkPgplotList *widget_list; /* The list to remove the widget from */ TkPgplot *tkpg = NULL; /* The widget being removed */ TkPgplot *prev; /* The widget preceding tkpg in the list */ /* * Get the widget list. */ widget_list = tkpg_WidgetList(type); if(widget_list) { tkpg = tkpg_FindWidgetByName(name, type, &prev); if(tkpg) { if(prev) { prev->next = tkpg->next; } else { widget_list->head = tkpg->next; }; tkpg->next = NULL; }; }; return tkpg; } /*....................................................................... * Prepend a PGPLOT widget to a given PGPLOT class widget list. * * Input: * tkpg TkPgplot * The widget to add to the list. * type int The enumerated name of the list to add to, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplot * The added widget (the same as tkpg), or NULL * on error. */ static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type) { TkPgplotList *widget_list; /* The list to prepend the widget to */ /* * Get the widget list. */ widget_list = tkpg_WidgetList(type); if(widget_list) { tkpg->next = widget_list->head; widget_list->head = tkpg; }; return tkpg; } /*....................................................................... * Return the currently selected PGPLOT device. * * Input: * context char * If no TkPgplot device is currently selected * and context!=NULL then, an error message of * the form printf("%s: ...\n", context) will * be written to stderr reporting that no * device is open. * Output: * return TkPgplot * The currently selected PGPLOT device, or * NULL if no device is currently selected. */ static TkPgplot *tkpg_CurrentWidget(char *context) { TkPgplot *tkpg = tkPgplotClassRec.active_widgets.head; if(!tkpg && context) fprintf(stderr, "%s: No /%s device is currently selected.\n", context, TK_PGPLOT_DEVICE); return tkpg; } /*....................................................................... * This is the only external entry point to the tk device driver. * It is called by PGPLOT to open, perform operations on, return * information about and close tk windows. * * Input: * ifunc int * The PGPLOT operation code to be executed. * Input/output: * rbuf float * A general buffer for input/output of float values. * nbuf int * Where relevant this is used to return the number of * elements in rbuf[]. Also used on input to specify * number of pixels in the line-of-pixels primitive. * chr char * A general buffer for string I/O. * lchr int * Where relevant this is used to send and return the * number of significant characters in chr. * Input: * len int Added to the call line by the FORTRAN compiler. * This contains the declared size of chr[]. */ #ifdef VMS void DRIV(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void DRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif /* * Get the active widget if there is one. */ TkPgplot *tkpg = tkpg_CurrentWidget(NULL); PgxWin *pgx = tkpg ? tkpg->pgx : NULL; int i; /* * Flush buffered opcodes. */ pgx_pre_opcode(pgx, *ifunc); /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { char *dev_name = TK_PGPLOT_DEVICE " (widget_path/" TK_PGPLOT_DEVICE ")"; strncpy(chr, dev_name, len); *lchr = strlen(dev_name); for(i = *lchr; i < len; i++) chr[i] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = -1.0; /* Report no effective max plot width */ rbuf[2] = 0.0; rbuf[3] = -1.0; /* Report no effective max plot height */ rbuf[4] = 0.0; rbuf[5] = (pgx && !pgx->bad_device) ? pgx->color->ncol-1 : 1; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: pgx_get_resolution(pgx, &rbuf[0], &rbuf[1]); rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'I'; /* Interactive device */ chr[1] = 'X'; /* Cursor is available and opcode 27 is desired */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines */ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ chr[7] = 'N'; /* Don't prompt on pgend */ chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10]= 'S'; /* Area-scroll available */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: chr[0] = '\0'; /* Default name is "" */ *lchr = 0; break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: pgx_def_size(pgx, Tk_Width(tkpg->tkwin), Tk_Height(tkpg->tkwin), rbuf, nbuf); break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: { TkPgplot *new_tkpg = tkpg_FindWidgetByID((int)(rbuf[1]+0.5), TKPG_ACTIVE_WIDGETS, NULL); if(new_tkpg) { new_tkpg->pgslct_id = (int) (rbuf[0]+0.5); tkpg_RemoveWidget(new_tkpg->pgx->name, TKPG_ACTIVE_WIDGETS); tkpg_PrependWidget(new_tkpg, TKPG_ACTIVE_WIDGETS); } else { fprintf(stderr, "%s: [Select plot] No such open device.\n", TKPG_IDENT); }; }; break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: /* * Assign the returned device unit number and success indicator. * Assume failure to open until the workstation is open. */ rbuf[0] = rbuf[1] = 0.0; *nbuf = 2; /* * Prepare the display name. */ if(*lchr >= len) { fprintf(stderr, "%s: Widget name too long.\n", TKPG_IDENT); return; } else { chr[*lchr] = '\0'; }; /* * Get the requested widget from the free widget list. */ tkpg = tkpg_open_widget(chr); if(!tkpg) return; rbuf[0] = tkpg->tkslct_id; /* The number used to select this device */ rbuf[1] = 1.0; *nbuf = 2; break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: /* * Remove the device from the list of open devices. */ if(pgx) tkpg_close_widget(pgx->name); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: pgx_begin_picture(pgx, rbuf); break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: pgx_draw_line(pgx, rbuf); break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: pgx_draw_dot(pgx, rbuf); break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: pgx_set_ci(pgx, (int) (rbuf[0] + 0.5)); break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: pgx_flush(pgx); break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: if(tkpg) tkpg_ClrCursor(tkpg); pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr); break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ /* (Not implemented: no alpha screen) */ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ /* (Not implemented: should not be called) */ case 19: break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: pgx_poly_fill(pgx, rbuf); break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: { int ci = (int)(rbuf[0]+0.5); pgx_set_rgb(pgx, ci, rbuf[1],rbuf[2],rbuf[3]); if(ci==0) tkpg_update_border(tkpg); }; break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: pgx_set_lw(pgx, rbuf[0]); break; /*--- IFUNC=23, Escape --------------------------------------------------*/ /* (Not implemented: ignored) */ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: pgx_rect_fill(pgx, rbuf); break; /*--- IFUNC=25, ---------------------------------------------------------*/ /* (Not implemented: ignored) */ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: pgx_pix_line(pgx, rbuf, nbuf); break; /*--- IFUNC=27, World-coordinate scaling --------------------------------*/ case 27: pgx_set_world(pgx, rbuf); break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: pgx_get_rgb(pgx, rbuf, nbuf); break; /*--- IFUNC=30, Scroll rectangle ----------------------------------------*/ case 30: pgx_scroll_rect(pgx, rbuf); break; /*--- IFUNC=?, ----------------------------------------------------------*/ default: fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n", TKPG_IDENT, *ifunc); *nbuf = -1; break; }; return; } /*....................................................................... * This function services TCL commands for a given widget. * * Input: * context ClientData The tkpg widget cast to (ClientData). * interp Tcl_Interp * The TCL intrepreter. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp, int argc, char *argv[]) { TkPgplot *tkpg = (TkPgplot *) context; char *widget; /* The name of the widget */ char *command; /* The name of the command */ /* * Get the name of the widget. */ widget = argv[0]; /* * Get the name of the command. */ if(argc < 2) { Tcl_AppendResult(interp, "Missing arguments to ", widget, " command.", NULL); return TCL_ERROR; }; command = argv[1]; /* * Prevent untimely deletion of the widget while this function runs. * Note that following this statement you must return via * tkpg_InstanceCommand_return() to ensure that Tk_Release() gets called. */ Tk_Preserve(context); /* * Check for recognized command names. */ if(strcmp(command, "xview") == 0) { /* X-axis scroll-bar update */ return tkpg_InstanceCommand_return(context, tkpg_scrollbar_callback(tkpg, interp, widget, command, argc-2, argv+2)); } else if(strcmp(command, "yview") == 0) { /* Y-axis scroll-bar update */ return tkpg_InstanceCommand_return(context, tkpg_scrollbar_callback(tkpg, interp, widget, command, argc-2, argv+2)); } else if(strcmp(command, "configure") == 0) { /* Configure widget */ /* * Check the number of configure arguments. */ switch(argc - 2) { case 0: /* Return the values of all configuration options */ return tkpg_InstanceCommand_return(context, Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs, (char *) tkpg, NULL, 0)); break; case 1: /* Return the value of a single given configuration option */ return tkpg_InstanceCommand_return(context, Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs, (char *) tkpg, argv[2], 0)); break; default: /* Change one of more of the configuration options */ return tkpg_InstanceCommand_return(context, tkpg_Configure(tkpg, interp, argc-2, argv+2, TK_CONFIG_ARGV_ONLY)); break; }; } else if(strcmp(command, "cget") == 0) { /* Get a configuration value */ if(argc != 3) { Tcl_AppendResult(interp, "Wrong number of arguments to \"", widget, " cget\" command", NULL); return tkpg_InstanceCommand_return(context, TCL_ERROR); } else { return tkpg_InstanceCommand_return(context, Tk_ConfigureValue(interp, tkpg->tkwin, configSpecs, (char *) tkpg, argv[2], 0)); }; } else if(strcmp(command, "setcursor") == 0) { /* Augment the cursor */ return tkpg_InstanceCommand_return(context, tkpg_tcl_setcursor(tkpg, interp, argc - 2, argv + 2)); } else if(strcmp(command, "clrcursor") == 0) { /* Clear cursor augmentation */ tkpg_ClrCursor(tkpg); return tkpg_InstanceCommand_return(context, TCL_OK); } else if(strcmp(command, "world") == 0) { /* Pixel to world coordinates */ return tkpg_InstanceCommand_return(context, tkpg_tcl_world(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "pixel") == 0) { /* World to pixel coordinates */ return tkpg_InstanceCommand_return(context, tkpg_tcl_pixel(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "id") == 0) { /* PGPLOT id of widget */ return tkpg_InstanceCommand_return(context, tkpg_tcl_id(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "device") == 0) { /* PGPLOT name for the widget */ return tkpg_InstanceCommand_return(context, tkpg_tcl_device(tkpg, interp, widget, argc-2, argv+2)); }; /* * Unknown command name. */ Tcl_AppendResult(interp, "Unknown command \"", widget, " ", command, "\"", NULL); return tkpg_InstanceCommand_return(context, TCL_ERROR); } /*....................................................................... * This is a private cleanup-return function of tkpg_InstanceCommand(). * It should be used to return from said function after Tk_Preserve() has * been called. It calls Tk_Release() on the widget to unblock deletion * and returns the specified error code. * * Input: * context ClientData The tkpg widget cast to (ClientData). * iret int TCL_OK or TCL_ERROR. * Output: * return int The value of iret. */ static int tkpg_InstanceCommand_return(ClientData context, int iret) { Tk_Release(context); return iret; } /*....................................................................... * This function is services TCL commands for a given widget. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * flags int The flags argument of Tk_ConfigureWidget(): * 0 - No flags. * TK_CONFIG_ARGV - Override the X defaults * database and the configSpecs * defaults. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[], int flags) { /* * Get the X-window pgplot object. */ PgxWin *pgx = tkpg->pgx; /* * Install the new defaults in tkpg. */ if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv, (char *) tkpg, flags) == TCL_ERROR) return TCL_ERROR; /* * Install the background color in PGPLOT color-index 0. */ pgx_set_background(pgx, Tk_3DBorderColor(tkpg->border)); /* * Install the foreground color in PGPLOT color-index 1. */ pgx_set_foreground(pgx, tkpg->normalFg); /* * Install changes to window attributes. */ { XSetWindowAttributes attr; /* The attribute-value container */ unsigned long mask = 0; /* The set of attributes that have changed */ attr.background_pixel = pgx->color->pixel[0]; mask |= CWBackPixel; attr.colormap = pgx->color->cmap; mask |= CWColormap; attr.border_pixel = pgx->color->pixel[0]; mask |= CWBorderPixel; attr.do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask | KeyPressMask | KeyReleaseMask; mask |= CWDontPropagate; Tk_ChangeWindowAttributes(tkpg->tkwin, mask, &attr); }; /* * Tell Tk what window size we want. */ Tk_GeometryRequest(tkpg->tkwin, tkpg->req_width, tkpg->req_height); /* * Tell pgxwin that the clip margin may have changed. */ tkpg_update_clip(tkpg); /* * Update the optional window margins. */ pgx_set_margin(pgx, tkpg->padx, tkpg->pady); /* * Refresh the window. */ tkpg_refresh_window(tkpg); return TCL_OK; } /*....................................................................... * This is the main X event callback for Pgplot widgets. * * Input: * context ClientData The tkpg widget cast to (ClientData). * event XEvent * The event that triggered the callback. */ static void tkpg_EventHandler(ClientData context, XEvent *event) { TkPgplot *tkpg = (TkPgplot *) context; /* * Determine what type of event triggered this call. */ switch(event->type) { case ConfigureNotify: /* The window has been resized */ tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg_update_clip(tkpg); tkpg_update_scroll_bars(tkpg); tkpg_refresh_window(tkpg); break; case DestroyNotify: /* The window has been destroyed */ /* * Delete the cursor event handler to prevent further use by user. */ tkpg_ClrCursor(tkpg); /* * Delete the main event handler to prevent prolonged use. */ Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); /* * Tell del_TkPgplot() that we have already deleted the event mask. */ tkpg->events.mask = NoEventMask; /* * Force the functions in pgxwin.c to discard subsequent graphics. */ if(tkpg->pgx) tkpg->pgx->window = None; /* * Queue deletion of tkpg until all references to the widget have been * completed. */ Tk_EventuallyFree(context, tkpg_FreeProc); break; case FocusIn: /* Keyboard-input focus has been acquired */ tkpg->events.focus_acquired = 1; tkpg_draw_focus_highlight(tkpg); break; case FocusOut: /* Keyboard-input focus has been lost */ tkpg->events.focus_acquired = 0; tkpg_draw_focus_highlight(tkpg); break; case Expose: /* Redraw the specified area */ tkpg_expose_handler(tkpg, event); break; }; return; } /*....................................................................... * The expose-event handler for PGPLOT widgets. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. * event XEvent The expose event that invoked the callback. */ static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event) { /* * Re-draw the focus-highlight border. */ tkpg_draw_focus_highlight(tkpg); /* * Re-draw the 3D borders. */ tkpg_draw_3d_border(tkpg); /* * Re-draw the damaged area. */ pgx_expose(tkpg->pgx, event); return; } /*....................................................................... * Re-draw the focus highlight border if it has a finite size. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. */ static void tkpg_draw_focus_highlight(TkPgplot *tkpg) { Window w = Tk_WindowId(tkpg->tkwin); /* * Re-draw the focus-highlight border. */ if(tkpg->highlight_thickness != 0) { GC gc = Tk_GCForColor(tkpg->events.focus_acquired ? tkpg->highlightColor : tkpg->highlightBgColor, w); Tk_DrawFocusHighlight(tkpg->tkwin, gc, tkpg->highlight_thickness, w); }; return; } /*....................................................................... * Re-draw the 3D border if necessary. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. */ static void tkpg_draw_3d_border(TkPgplot *tkpg) { Tk_Window tkwin = tkpg->tkwin; Window w = Tk_WindowId(tkwin); /* * Re-draw the focus-highlight border. */ if(tkpg->border && tkpg->borderWidth > 0) { int margin = tkpg->highlight_thickness; Tk_Draw3DRectangle(tkwin, w, tkpg->border, margin, margin, Tk_Width(tkwin) - 2*margin, Tk_Height(tkwin) - 2*margin, tkpg->borderWidth, tkpg->relief); }; return; } /*....................................................................... * Augment the cursor of a given widget. * * Input: * tkpg TkPgplot * The PGPLOT widget to connect a cursor to. * mode TkpgCursorMode The type of cursor augmentation. * xref,yref float The world-coordinate reference point for band-type * cursors. * ci int The color index with which to plot the cursor, * or -1 to select the current foreground color. * Output: * return int TCL_OK or TCL_ERROR. */ static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode, float xref, float yref, int ci) { PgxWin *pgx = tkpg->pgx; float rbuf[2]; /* * Remove any existing cursor augmentation. */ tkpg_ClrCursor(tkpg); /* * Mark the cursor as active. */ tkpg->events.cursor_active = 1; /* * Convert xref, yref from world coordinates to device coordinates. */ rbuf[0] = xref; rbuf[1] = yref; pgx_world2dev(pgx, rbuf); /* * Raise the cursor. */ if(pgx_set_cursor(pgx, ci, (int)mode, 0, rbuf, rbuf)) { Tcl_AppendResult(tkpg->interp, "Unable to display cursor.\n", NULL); tkpg_ClrCursor(tkpg); return TCL_ERROR; }; /* * If the pointer is currently in the window, record its position * and draw the cursor. */ if(pgx_locate_cursor(pgx)) pgx_draw_cursor(pgx); /* * Create an event handler to handle asychronous cursor input. */ Tk_CreateEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK, tkpg_CursorHandler, (ClientData) tkpg); return TCL_OK; } /*....................................................................... * This is the X event callback for Pgplot cursor events. It is called * only when the cursor augmentation has been established by * tkpg_SetCursor() and not cleared by tkpg_ClrCursor(). * * Input: * context ClientData The tkpg widget cast to (ClientData). * event XEvent * The event that triggered the callback. */ static void tkpg_CursorHandler(ClientData context, XEvent *event) { TkPgplot *tkpg = (TkPgplot *) context; PgxWin *pgx = tkpg->pgx; float rbuf[2]; char key; /* * Handle the event. Note that button-press and keyboard events * have not been selected so the return values are irrelevent. */ (void) pgx_cursor_event(pgx, event, rbuf, &key); /* * Handle errors. */ if(pgx->bad_device) tkpg_ClrCursor(tkpg); return; } /*....................................................................... * Clear the cursor of a given widget. * * tkpg TkPgplot * The widget to disconnect the cursor from. */ static void tkpg_ClrCursor(TkPgplot *tkpg) { if(tkpg) { PgxWin *pgx = tkpg->pgx; /* * Do nothing if the cursor is inactive. */ if(tkpg->events.cursor_active) { /* * Remove the current event handler. */ Tk_DeleteEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK, tkpg_CursorHandler, (ClientData) tkpg); /* * Reset the cursor context to its inactive state. */ tkpg->events.cursor_active = 0; /* * Erase the cursor. */ pgx_erase_cursor(pgx); pgx_set_cursor(pgx, 0, TKPG_NORM_CURSOR, 0, NULL, NULL); }; }; return; } /*....................................................................... * Augment the cursor as specified in the arguments of the setcursor * widget command. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The type of cursor augmentation, from: * norm - Un-augmented X cursor * line - Line cursor between ref and pointer * rect - Rectangle between ref and pointer * yrng - Horizontal lines at ref.x & pointer.x * xrng - Vertical lines at ref.y & pointer.y * hline - Horizontal line cursor at y=ref.y * vline - Vertical line cursor at x=ref.x * cross - Pointer centered cross-hair * [1] The X-axis world coordinate at which * to anchor rect,yrng and xrng cursors. * [2] The Y-axis world coordinate at which * to anchor rect,yrng and xrng cursors. * [3] The color index of the cursor. * flags int The flags argument of Tk_ConfigureWidget(): * 0 - No flags. * TK_CONFIG_ARGV - Override the X defaults * database and the configSpecs * defaults. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[]) { TkpgCursorMode mode; /* Cursor augmentation mode */ double xref,yref; /* The X and Y reference positions of the cursor */ int ci; /* The color index used to draw the cursor */ int found = 0; /* True once the mode has been identified */ int i; /* * List the correspondence between cursor-mode names and pgband() mode * enumerators. */ struct { TkpgCursorMode mode; char *name; } modes[] = { {TKPG_NORM_CURSOR, "norm"}, /* Un-augmented X cursor */ {TKPG_LINE_CURSOR, "line"}, /* Line cursor between ref and pointer */ {TKPG_RECT_CURSOR, "rect"}, /* Rectangle between ref and pointer */ {TKPG_YRNG_CURSOR, "yrng"}, /* Horizontal lines at ref.x & pointer.x */ {TKPG_XRNG_CURSOR, "xrng"}, /* Vertical lines at ref.y & pointer.y */ {TKPG_HLINE_CURSOR, "hline"},/* Horizontal line cursor at y=ref.y */ {TKPG_VLINE_CURSOR, "vline"},/* Vertical line cursor at x=ref.x */ {TKPG_CROSS_CURSOR, "cross"},/* Pointer centered cross-hair */ }; /* * Check that we have the expected number of arguments. */ if(argc != 4) { Tcl_AppendResult(interp, "Wrong number of arguments. Should be: \"", tkpg->pgx->name, " setcursor mode x y ci", NULL); return TCL_ERROR; }; /* * Make sure that the widget is currently open to PGPLOT. */ if(tkpg->pgslct_id == 0) { Tcl_AppendResult(interp, tkpg->pgx->name, " setcursor: Widget not open to PGPLOT.", NULL); return TCL_ERROR; }; /* * Lookup the cursor mode. */ mode = TKPG_NORM_CURSOR; for(i=0; !found && idevice; } /*....................................................................... * Return the pgslct_id of the given Rivet pgplot widget. This can then * be used with the cpgslct() function to select the widget as the currently * active widget. * * Input: * widget Rivetobj A rivet pgplot widget. * Output: * return int The PGPLOT device-id. This will be 0 if the widget * is not currently open to PGPLOT. */ int rvp_device_id(Rivetobj widget) { TkPgplot *tkpg = (TkPgplot *) widget; return tkpg->pgslct_id; } /*....................................................................... * Convert from X window pixel coordinates to PGPLOT world coordinates. * * Input: * widget Rivetobj A rivet pgplot widget. * px, py int The X-window pixel coordinates to be converted. * wx, wy float * The corresponding PGPLOT world coordinates are * assigned to the variables pointed to by wx and wy. * Output: * return int 0 - OK. * 1 - Error. */ int rvp_xwin2world(Rivetobj widget, int px, int py, float *wx, float *wy) { TkPgplot *tkpg = (TkPgplot *) widget; float rbuf[2]; /* * Convert from pixels to world coordinates. */ if(pgx_win2dev(tkpg->pgx, px, py, rbuf) || pgx_dev2world(tkpg->pgx, rbuf)) return 1; /* * Assign the return values. */ *wx = rbuf[0]; *wy = rbuf[1]; return 0; } /*....................................................................... * Convert from PGPLOT world coordinates to X window pixel coordinates. * * Input: * widget Rivetobj A rivet pgplot widget. * wx, wy float The PGPLOT world coordinates to be converted. * px, py int * The corresponding X-window pixel coordinates are * assigned to the variables pointed to by px and py. * Output: * return int 0 - OK. * 1 - Error. */ int rvp_world2xwin(Rivetobj widget, float wx, float wy, int *px, int *py) { TkPgplot *tkpg = (TkPgplot *) widget; float rbuf[2]; /* * Convert from world coordinates to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; if(pgx_world2dev(tkpg->pgx, rbuf) || pgx_dev2win(tkpg->pgx, rbuf, px, py)) return 1; return 0; } #endif /*....................................................................... * Refresh the contents of the window. * * Input: * tkpg TkPgplot * The widget record to be configured. * Output: * return int 0 - OK. * 1 - Error. */ static int tkpg_refresh_window(TkPgplot *tkpg) { if(Tk_IsMapped(tkpg->tkwin)) { tkpg_draw_focus_highlight(tkpg); tkpg_draw_3d_border(tkpg); return pgx_scroll(tkpg->pgx, tkpg->scroll.x, tkpg->scroll.y); }; return 0; } /*....................................................................... * Whenever the color representation of the background color is changed * via PGPLOT, this function is called to update the Tk 3D border. * * Input: * tkpg TkPgplot * The associated PGPLOT widget. */ static void tkpg_update_border(TkPgplot *tkpg) { XColor *bg; /* The new background color */ char cname[20]; /* The color as a string of the form #rrrrggggbbbb */ Tk_3DBorder bd; /* The new Tk border */ /* * Get the PGPLOT background color. */ bg = &tkpg->pgx->color->xcolor[0]; /* * Tk_Get3DBorder requires a standard X color resource string. */ sprintf(cname, "#%4.4hx%4.4hx%4.4hx", bg->red, bg->green, bg->blue); bd = Tk_Get3DBorder(tkpg->interp, tkpg->tkwin, cname); if(bd) { /* * Replace the previous border with the new one. */ if(tkpg->border) Tk_Free3DBorder(tkpg->border); tkpg->border = bd; tkpg_draw_3d_border(tkpg); } else { fprintf(stderr, "Tk_Get3DBorder failed: %s\n", tkpg->interp->result); }; } /*....................................................................... * Respond to an xview or yview scrollbar command. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * view char * "xview" or "yview". * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]) { int window_size; /* The size of the window along the direction of motion */ int pixmap_size; /* The size of the pixmap along the direction of motion */ int new_start_pos;/* The new pixmap coord of the top|left of the window */ int old_start_pos;/* The old pixmap coord of the top|left of the window */ /* * Fill in the current scroll-statistics along the requested direction. */ if(*view == 'x') { window_size = Tk_Width(tkpg->tkwin); pixmap_size = pgx_pixmap_width(tkpg->pgx); old_start_pos = tkpg->scroll.x; } else { window_size = Tk_Height(tkpg->tkwin); pixmap_size = pgx_pixmap_height(tkpg->pgx); old_start_pos = tkpg->scroll.y; }; /* * The first argument specifies what form of scrollbar command has * been received (see 'man scrollbar' for details). */ if(argc < 1) { return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * The moveto command requests a new start position as a * fraction of the pixmap size. */ } else if(strcmp(argv[0], "moveto")==0) { double fractional_position; if(argc != 2) return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * Read the fractional position. */ if(Tcl_GetDouble(interp, argv[1], &fractional_position) == TCL_ERROR) return TCL_ERROR; new_start_pos = fractional_position * pixmap_size; /* * The "scroll" command specifies an increment to move the pixmap by * and the units to which the increment refers. */ } else if(strcmp(argv[0], "scroll")==0) { int scroll_increment; if(argc != 3) return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * Read the scroll-increment. */ if(Tcl_GetInt(interp, argv[1], &scroll_increment) == TCL_ERROR) return TCL_ERROR; /* * The unit of the increment can either be "units", which in our case * translates to a single pixel, or "pages", which corresponds to the * width/height of the window. */ if(strcmp(argv[2], "units")==0) { new_start_pos = old_start_pos + scroll_increment; } else if(strcmp(argv[2], "pages")==0) { int page_size = window_size - 2 * (tkpg->highlight_thickness + tkpg->borderWidth); if(page_size < 0) page_size = 0; new_start_pos = old_start_pos + scroll_increment * page_size; } else { return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); }; } else { Tcl_AppendResult(interp, "Unknown xview command \"", argv[0], "\"", NULL); return TCL_ERROR; }; /* * Keep the pixmap visible. */ if(new_start_pos < 0 || window_size > pixmap_size) { new_start_pos = 0; } else if(new_start_pos + window_size > pixmap_size) { new_start_pos = pixmap_size - window_size; }; /* * Record the top left corner of the new scrolling-area. */ if(*view == 'x') tkpg->scroll.x = new_start_pos; else tkpg->scroll.y = new_start_pos; /* * Update the scrolled area and the scrollbar slider. */ tkpg_update_scroll_bars(tkpg); return TCL_OK; } /*....................................................................... * This is a private error-return function of tkpg_scrollbar_callback(). * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * view char * "xview" or "yview". * argc int The number of arguments in argv. * argv char ** The array of 'argc' configuration arguments. * Output: * return int TCL_ERROR and the context of the error * is recorded in interp->result. */ static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]) { int i; Tcl_AppendResult(interp, "Bad command: ", widget, " ", view, NULL); for(i=0; i\" or \"scroll -1|1 units|pages\"", NULL); return TCL_ERROR; } /*....................................................................... * Implement the Tcl world function. This converts an X-window * pixel coordinate to the corresponding PGPLOT world coordinate. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The coordinate axes to convert, from: * "x" - Convert an X-axis coord. * "y" - Convert a Y-axis coord. * "xy" - Convert a an X Y axis pair. * [1] An X-axis pixel coordinate if [0][0] is * 'x'. * A Y-axis pixel coordinate if [0][0] is * 'y'. * [2] This is only expected if [0]=="xy". It * should then contain the Y-axis * coordinate to be converted. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { int xpix, ypix; /* The input X window coordinate */ float rbuf[2]; /* The conversion buffer */ char *axis; /* The axis specification string */ enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */ int axtype; /* The decoded axis type */ char *usage = " world [x ]|[y ]|[xy ]"; /* * Check that an axis specification argument has been provided. */ if(argc < 1) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Decode the axis type and check the expected argument count. */ axis = argv[0]; axtype = BAD_AXIS; switch(*axis++) { case 'x': switch(*axis++) { case 'y': if(*axis == '\0' && argc == 3) axtype = XY_AXIS; break; case '\0': if(argc == 2) axtype = X_AXIS; break; }; break; case 'y': if(*axis == '\0' && argc == 2) axtype = Y_AXIS; break; }; /* * Unrecognised axis description? */ if(axtype == BAD_AXIS) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Get the pixel coordinates to be converted. */ switch(axtype) { case X_AXIS: if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR) return TCL_ERROR; ypix = 0; break; case Y_AXIS: xpix = 0; if(Tcl_GetInt(interp, argv[1], &ypix) == TCL_ERROR) return TCL_ERROR; break; case XY_AXIS: if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR || Tcl_GetInt(interp, argv[2], &ypix) == TCL_ERROR) return TCL_ERROR; break; }; /* * Convert the pixel coordinates to world coordinates. */ pgx_win2dev(tkpg->pgx, xpix, ypix, rbuf); pgx_dev2world(tkpg->pgx, rbuf); /* * Write the world coordinate(s) into the reply string. */ switch(axtype) { case X_AXIS: Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case Y_AXIS: Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case XY_AXIS: Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; }; return TCL_OK; } /*....................................................................... * Implement the Tcl pixel function. This converts PGPLOT world * coordinates to X-window pixel coordinates. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The coordinate axes to convert, from: * "x" - Convert an X-axis coord. * "y" - Convert a Y-axis coord. * "xy" - Convert a an X Y axis pair. * [1] An X-axis world coordinate if [0][0] is * 'x'. * A Y-axis world coordinate if [0][0] is * 'y'. * [2] This is only expected if [0]=="xy". It * should then contain the Y-axis * coordinate to be converted. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { double wx, wy; /* The world X and Y coordinates to be converted */ int xpix, ypix; /* The output X window coordinate */ float rbuf[2]; /* The conversion buffer */ char *axis; /* The axis specification string */ enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */ int axtype; /* The decoded axis type */ char *usage = " pixel [x ]|[y ]|[xy ]"; /* * Check that an axis specification argument has been provided. */ if(argc < 1) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Decode the axis type and check the expected argument count. */ axis = argv[0]; axtype = BAD_AXIS; switch(*axis++) { case 'x': switch(*axis++) { case 'y': if(*axis == '\0' && argc == 3) axtype = XY_AXIS; break; case '\0': if(argc == 2) axtype = X_AXIS; break; }; break; case 'y': if(*axis == '\0' && argc == 2) axtype = Y_AXIS; break; }; /* * Unrecognised axis description? */ if(axtype == BAD_AXIS) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Get the pixel coordinates to be converted. */ switch(axtype) { case X_AXIS: if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR) return TCL_ERROR; wy = 0; break; case Y_AXIS: wx = 0; if(Tcl_GetDouble(interp, argv[1], &wy) == TCL_ERROR) return TCL_ERROR; break; case XY_AXIS: if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR || Tcl_GetDouble(interp, argv[2], &wy) == TCL_ERROR) return TCL_ERROR; break; }; /* * Convert the world coordinate to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; pgx_world2dev(tkpg->pgx, rbuf); pgx_dev2win(tkpg->pgx, rbuf, &xpix, &ypix); /* * Write the pixel coordinate(s) into the reply string. */ switch(axtype) { case X_AXIS: sprintf(tkpg->buffer, "%d", xpix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case Y_AXIS: sprintf(tkpg->buffer, "%d", ypix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case XY_AXIS: sprintf(tkpg->buffer, "%d %d", xpix, ypix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; }; return TCL_OK; } /*....................................................................... * Implement the Tcl "return PGPLOT id" function. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * (None are expected). * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { /* * There shouldn't be any arguments. */ if(argc != 0) { Tcl_AppendResult(interp, "Usage: ", widget, " id", NULL); return TCL_ERROR; }; /* * Return the id in the Tcl result string. */ sprintf(tkpg->buffer, "%d", tkpg->pgslct_id); Tcl_AppendResult(interp, tkpg->buffer, NULL); return TCL_OK; } /*....................................................................... * Implement the Tcl "return PGPLOT device specifier" function. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * (None are expected). * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { /* * There shouldn't be any arguments. */ if(argc != 0) { Tcl_AppendResult(interp, "Usage: ", widget, " device", NULL); return TCL_ERROR; }; /* * Return the device specifier in the Tcl result string. */ Tcl_AppendResult(interp, tkpg->device, NULL); return TCL_OK; } /*....................................................................... * Return the toplevel window ID of a given tk pathname. * * Input: * interp Tcl_Interp * The TCL intrepreter. * main_w Tk_Window The main window of the application. * path char * The tk path name of a window. * Output: * return Tk_Window The top-level window of the path, or NULL if * it doesn't exist. In the latter case an error * message will have been appended to interp->result. */ static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w, char *path) { char *endp; /* The element in path[] following the first path component */ char *first; /* A copy of the first component of the pathname */ int length; /* The length of the first component of the pathname */ Tk_Window w; /* The Tk window of the first component of the pathname */ /* * The first character of the path should be a dot. */ if(!path || *path == '\0' || *path != '.') { Tcl_AppendResult(interp, "Unknown window: ", path ? path : "(null)", NULL); return NULL; }; /* * Find the end of the first component of the pathname. */ for(endp=path+1; *endp && *endp != '.'; endp++) ; length = endp - path; /* * Make a copy of the name of the first component of the path name. */ first = malloc(length + 1); if(!first) { Tcl_AppendResult(interp, "Ran out of memory while finding toplevel window.", NULL); return NULL; }; strncpy(first, path, length); first[length] = '\0'; /* * Lookup the corresponding window. */ w = Tk_NameToWindow(interp, first, main_w); /* * Discard the copy. */ free(first); /* * If the window doesn't exist, Tk_NameToWindow() is documented to place * an error message in interp->result, so just return the error condition. */ if(!w) return NULL; /* * If the looked up window is a toplevel window return it, otherwise * the toplevel for the specified path must be the main window. */ return Tk_IsTopLevel(w) ? w : main_w; } OR - Failure. */ static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { int xpix, ypix; /* The input X window coordinate */ float rbuf[2]; /* The cpgplot/drivers/xtk/tkpgplot.h010064400040640000322000000005330653617607400170520ustar00tjpcitmbr00000400000017#ifndef tkpgplot_h #define tkpgplot_h #ifdef __cplusplus extern "C" { #endif #include #include /* Tk PGPLOT-widget package-initialization command */ int Tkpgplot_Init(Tcl_Interp *interp); /* * Record the official PGPLOT device name of the widget driver. */ #define TK_PGPLOT_DEVICE "XTK" #ifdef __cplusplus } #endif #endif pgplot/drivers/xtk/rvpgplot.h010064400040640000322000000031030635036166600170540ustar00tjpcitmbr00000400000017#ifndef rvpgplot_h #define rvpgplot_h #ifdef __cplusplus extern "C" { #endif #define RIVETONLY #include /* Rivet/Tk PGPLOT-widget package-initialization command */ int Rvpgplot_Init(Tcl_Interp *interp); /* * Record the official PGPLOT device name of the widget driver. */ #define TK_PGPLOT_DEVICE "XRV" /* * The following function returns an unambiguous PGPLOT device-specification * that can be used as the FILE argument of cpgbeg() to open a given PGPLOT * widget. It simply returns a string composed of the widget name, followed * by a "/" followed by TK_PGPLOT_DEVICE. Note that the returned string is * owned by the widget and must not be free()d or overwritten. */ char *rvp_device_name(Rivetobj); /* * After a widget has been opened to PGPLOT (via pgopen or pgbeg), the * following function can be used to return the PGPLOT id of the device. * When multiple PGPLOT devices are open this id can then be used with * the PGPLOT cpgslct() function to select the widget as the currently * selected PGPLOT graphics device. * * If the specified widget has not been opened to pgplot, or has been * closed and not re-opened, then 0 will be returned. */ int rvp_device_id(Rivetobj); /* * Convert from X window pixel coordinates (px,py) to PGPLOT * world coordinates (*wx,*wy). */ int rvp_xwin2world(Rivetobj widget, int px, int py, float *wx, float *wy); /* * Convert from PGPLOT world coordinates (wx,wy) to X window * pixel coordinates (*px,*py). */ int rvp_world2xwin(Rivetobj widget, float wx, float wy, int *px, int *py); #ifdef __cplusplus } #endif #endif pgplot/drivers/xadriv.c010064400040640000322000000042600635505240200156540ustar00tjpcitmbr00000400000017#include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow xadriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call xadriv() or xadriv_(). */ #ifdef PG_PPU #define XADRIV xadriv_ #else #define XADRIV xadriv #endif /*....................................................................... * This is a stub version of the Athena PGPLOT widget device driver to * be included in the main PGPLOT library. The real driver resides in a * dedicated library, which when cited before libpgplot on the link line, * overrides this stub. The rational behind this is that if the real * driver were included in the PGPLOT library all applications that are * currently linked with PGPLOT would have to be changed to link with the * Xaw library. */ #ifdef VMS void xadriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void XADRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif int i; /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: for(i=0; i < len; i++) chr[i] = ' '; *lchr = 0; break; default: fprintf(stderr, "/XATHENA: Unexpected opcode=%d in stub driver.\n", *ifunc); *nbuf = -1; break; }; return; } _s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow xadriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments fpgplot/drivers/xathena/XaPgplot.c010064400040640000322000001531030650112263100175410ustar00tjpcitmbr00000400000017/* * Changes: */ /* Athena pgplot widget class implementation */ #include #include #include #include #include #include #include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Allow xadriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call xadriv() or xadriv_(). */ #ifdef PG_PPU #define XADRIV xadriv_ #else #define XADRIV xadriv #endif #include "XaPgplotP.h" /* * Set the default size of the widget. */ #define XAP_MIN_WIDTH 64 /* Minimum width (pixels) */ #define XAP_MIN_HEIGHT 64 /* Minimum height (pixels) */ #define XAP_DEF_WIDTH 256 /* Default width (pixels) */ #define XAP_DEF_HEIGHT 256 /* Default height (pixels) */ #define XAP_MIN_COLORS 2 /* Min number of colors per colormap */ #define XAP_DEF_COLORS 100 /* Default number of colors to try for */ #define XAP_MAX_COLORS 255 /* Max number of colors per colormap */ #define XAP_DEF_MARGIN 20 /* The number of pixels to assign to the margin */ #define XAP_DEF_SHARE 0 /* Default to allocating shared colors */ /* * Specify the name to prefix errors with. */ #define XAP_IDENT "PgplotWidget" static void xap_GetDefaultBackgroundColor(Widget widget, int offset, XrmValue *value); static void xap_GetDefaultForegroundColor(Widget widget, int offset, XrmValue *value); /* * Define all the X resources that are to be understood by the * widget. */ static XtResource resources[] = { { XapNminColors, XapCMinColors, XtRInt, sizeof(int), XtOffsetOf(XaPgplotRec, pgplot.min_colors), XtRImmediate, (XtPointer) XAP_MIN_COLORS }, { XapNmaxColors, XapCMaxColors, XtRInt, sizeof(int), XtOffsetOf(XaPgplotRec, pgplot.max_colors), XtRImmediate, (XtPointer) XAP_DEF_COLORS }, { XtNvisual, XtCVisual, XtRVisual, sizeof(Visual *), XtOffsetOf(XaPgplotRec, pgplot.visual), XtRImmediate, (XtPointer) CopyFromParent }, { XtNresizeCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), XtOffsetOf(XaPgplotRec, pgplot.resize_callback), XtRImmediate, (XtPointer) NULL }, { XtNbackground, XtCBackground, XtRPixel, sizeof(Pixel), XtOffsetOf(XaPgplotRec, core.background_pixel), XtRCallProc, (XtPointer) xap_GetDefaultBackgroundColor }, { XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), XtOffsetOf(XaPgplotRec, pgplot.fgpixel), XtRCallProc, (XtPointer) xap_GetDefaultForegroundColor }, { XapNpadX, XapCPadX, XtRDimension, sizeof(Dimension), XtOffsetOf(XaPgplotRec, pgplot.pad_x), XtRImmediate, (XtPointer) XAP_DEF_MARGIN }, { XapNpadY, XapCPadY, XtRDimension, sizeof(Dimension), XtOffsetOf(XaPgplotRec, pgplot.pad_y), XtRImmediate, (XtPointer) XAP_DEF_MARGIN }, { XapNshare, XapCShare, XtRBoolean, sizeof(Boolean), XtOffsetOf(XaPgplotRec, pgplot.share), XtRImmediate, (XtPointer) XAP_DEF_SHARE }, }; /* * Declare class method functions. */ static void xap_ClassPartInit(WidgetClass w); static void xap_Initialize(Widget request, Widget new_w, ArgList args, Cardinal *num_args); static void xap_Realize(Widget widget, XtValueMask *mask, XSetWindowAttributes *attributes); static void xap_Resize(Widget widget); static void xap_Destroy(Widget widget); static void xap_Expose(Widget widget, XEvent *event, Region region); static Boolean xap_SetValues(Widget old_widget, Widget req_widget, Widget new_widget, ArgList args, Cardinal *num_args); static XtGeometryResult xap_Query_Geometry(Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *reply); /* * Define the Athena Pgplot class shared context descriptor. */ externaldef(xapgplotclassrec) XaPgplotClassRec xaPgplotClassRec = { { /* core_class fields */ /* superclass */ (WidgetClass) &simpleClassRec, /* class_name */ "XaPgplot", /* widget_size */ sizeof(XaPgplotRec), /* class_initialize */ NULL, /* class_part_initiali*/ xap_ClassPartInit, /* class_inited */ FALSE, /* initialize */ xap_Initialize, /* initialize_hook */ NULL, /* realize */ xap_Realize, /* actions */ NULL, /* num_actions */ 0, /* resources */ resources, /* num_resources */ XtNumber(resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, /* compress_exposure */ XtExposeCompressMultiple, /* compress_enterleave*/ TRUE, /* visible_interest */ FALSE, /* destroy */ xap_Destroy, /* resize */ xap_Resize, /* expose */ xap_Expose, /* set_values */ xap_SetValues, /* set_values_hook */ NULL, /* set_values_almost */ XtInheritSetValuesAlmost, /* get_values_hook */ NULL, /* accept_focus */ NULL, /* version */ XtVersion, /* callback_private */ NULL, /* tm_table */ NULL, /* query_geometry */ xap_Query_Geometry, /* display accel */ XtInheritDisplayAccelerator, /* extension */ NULL }, { /* Simple class fields */ /* change_sensitive */ XtInheritChangeSensitive }, { /* Pgplot class fields */ /* widget_id_counter */ 0, /* active_widgets */ {NULL}, /* free_widgets */ {NULL}, /* Extension */ NULL } }; /* * Declare a global class pointer for use in XtCreateManagedWidget * calls. */ externaldef(xapgplotwidgetclass) WidgetClass xaPgplotWidgetClass = (WidgetClass) &xaPgplotClassRec; /* * Private functions. */ static void xap_abort(XaPgplotPart *xap, char *msg); static XaPgplotWidget xap_open_widget(char *name); static XaPgplotWidget xap_close_widget(char *name); static void xap_update_clip(XaPgplotWidget w); static void xap_NewPixmap(PgxWin *pgx, unsigned width, unsigned height); static void xap_CursorHandler(Widget widget, XtPointer client_data, XEvent *event, Boolean *cont); static int xap_ArmCursor(XaPgplotWidget w, int mode, float xref, float yref, XtCallbackProc callback, void *client_data); static int xap_DisarmCursor(XaPgplotWidget w); static int xap_new_visual(XaPgplotWidget w); static int xap_WorldToPixel(XaPgplotWidget w, float wx, float wy, int *px, int *py); static int xap_PixelToWorld(XaPgplotWidget w, int px, int py, float *wx, float *wy); /* Enumerate the PGPLOT class widget lists */ #define XAP_ACTIVE_WIDGETS 1 #define XAP_FREE_WIDGETS 2 static XaPgplotList *xap_WidgetList(int type); static XaPgplotWidget xap_FindWidgetByName(char *name, int type, XaPgplotWidget *prev); static XaPgplotWidget xap_FindWidgetByID(int xaslct_id, int type, XaPgplotWidget *prev); static XaPgplotWidget xap_RemoveWidget(char *name, int type); static XaPgplotWidget xap_PrependWidget(XaPgplotWidget w, int type); static XaPgplotWidget xap_CurrentWidget(char *context); /*....................................................................... * This is called once to initialize the PGPLOT part of the widget class * structure when the first widget instance of this type is created. * * Input: * w WidgetClass The class record to be initialized. */ static void xap_ClassPartInit(WidgetClass w) { XaPgplotWidgetClass class = (XaPgplotWidgetClass) w; XaPgplotClassPart *pgplot = &class->pgplot_class; pgplot->widget_id_counter = 0; pgplot->active_widgets.head = NULL; pgplot->free_widgets.head = NULL; pgplot->extension = NULL; return; } /*....................................................................... * This is called to check resource derived defaults and initialize * a PGPLOT widget instance. * * Input: * request Widget The instance widget type with the resource values * requested by the client. * new_w Widget The resulting instance widget with allowed * resource values. * args ArgList The widget-creation argument list used to override * default values. * num_args Cardinal The number of arguments in args. */ static void xap_Initialize(Widget request, Widget new_w, ArgList args, Cardinal *num_args) { XaPgplotWidget w = (XaPgplotWidget) new_w; XaPgplotPart *xap = &w->pgplot; /* * Initialize the private attributes. */ xap->next = NULL; xap->xaslct_id = xaPgplotClassRec.pgplot_class.widget_id_counter++; xap->pgslct_id = 0; /* This is filled in by the first select-plot opcode */ xap->device = NULL; xap->app = XtWidgetToApplicationContext(new_w); xap->input.mask = 0; xap->input.callback = 0; xap->input.client_data = NULL; xap->bg.red = xap->bg.green = xap->bg.blue = 0; xap->fg.red = xap->fg.green = xap->fg.blue = 65535; xap->pgx = NULL; /* * Record the RGB values of the default background and foreground * colors. */ XtVaGetValues(new_w, XtVaTypedArg, XtNbackground, XtRColor, &xap->bg, sizeof(xap->bg), XtVaTypedArg, XtNforeground, XtRColor, &xap->fg, sizeof(xap->fg), NULL); /* * Allocate the PGPLOT-window context descriptor. */ xap->pgx = new_PgxWin(XtDisplay(new_w), XScreenNumberOfScreen(XtScreen(new_w)), (void *) w, XtName(new_w), 0, xap_NewPixmap); if(!xap->pgx) xap_abort(xap, NULL); /* * Compose a sample PGPLOT device-specification for use in opening this * widget to PGPLOT. */ xap->device = (char *) malloc(sizeof(char) * (strlen(xap->pgx->name) + 1 + strlen(XAP_DEVICE) + 1)); if(!xap->device) xap_abort(xap, "Insufficient memory.\n"); sprintf(xap->device, "%s/%s", xap->pgx->name, XAP_DEVICE); /* * Check the widget size. */ if(w->core.width==0) w->core.width = XAP_DEF_WIDTH; if(w->core.height==0) w->core.height = XAP_DEF_HEIGHT; if(w->core.width < XAP_MIN_WIDTH) w->core.width = XAP_MIN_WIDTH; if(w->core.height < XAP_MIN_HEIGHT) w->core.height = XAP_MIN_HEIGHT; /* * Check color resources. */ if(xap->min_colors < XAP_MIN_COLORS) xap->min_colors = XAP_MIN_COLORS; if(xap->max_colors > XAP_MAX_COLORS) xap->max_colors = XAP_MAX_COLORS; /* * See if the parent widget is a scrolled window. */ return; } /*....................................................................... * Create and clear the window of a PGPLOT widget instance. * * Input: * widget Widget The widget to be realized. * mask XtValueMask * The bit-mask that specifies which * attributes have been set in 'attr'. * attr XSetWindowAttributes * The container of the pre-set window * attributes specified in 'mask'. */ static void xap_Realize(Widget widget, XtValueMask *mask, XSetWindowAttributes *attr) { XaPgplotWidget w = (XaPgplotWidget) widget; XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; /* * Get a visual and colormap for the window if necessary. */ if(!pgx->color) { if(!xap->share && xap_new_visual(w)) /* If requested try private first */ xap->share = 1; if(xap->share && xap_new_visual(w)) { /* Try for shared colors */ fprintf(stderr, "%s: There are insufficient colors, so black and white will be used.\n", XAP_IDENT); if(!pgx_bw_visual(pgx)) xap_abort(xap, "No colors.\n"); }; }; /* * Keep the resource-value record of the chosen visual and colormap * in sync with the values in pgx->color. */ xap->visual = pgx->color->vi->visual; w->core.colormap = pgx->color->cmap; /* * Reset the background and foreground colors to match the current * X resource values. */ pgx_set_background(pgx, &xap->bg); pgx_set_foreground(pgx, &xap->fg); /* * The window attributes passed to this function are based on * attributes stored in the core record of the widget instance. * By default these attributes (set by X resources) cause the * new window to inherit colormap, depth, etc.. from the parent * window. Since the call to pgx_new_visual() may have invalidated this * we need to install new values. This involves both updating the * window attributes to be passed to XtCreateWindow() and modifying * the X resources of the core part of the instance structure. * * It is important to remember that the border and background pixmaps * need to be changed to avoid mismatches between their depths and the * depth of our chosen visual. To avoid such conflicts we will make sure * that pixmaps are not used and substitute solid colors. */ /* * Add and remove appropriate window attributes. */ *mask |= CWDontPropagate | CWBackPixel | CWBorderPixel | CWColormap; *mask &= ~(CWBackPixmap | CWBorderPixmap); attr->do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask | KeyPressMask | KeyReleaseMask; attr->background_pixel = xap->pgx->color->pixel[0]; attr->border_pixel = xap->pgx->color->pixel[0]; attr->colormap = w->core.colormap; /* * Record the new attributes in the core part of the instance record. */ XtVaSetValues(widget, XtNbackground, xap->pgx->color->pixel[0], XtNborderColor, xap->pgx->color->pixel[0], XtNdepth, xap->pgx->color->vi->depth, NULL); /* * Create the window. */ XtCreateWindow(widget, InputOutput, xap->visual, *mask, attr); pgx->window = XtWindow(widget); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ { XGCValues gcv; gcv.graphics_exposures = False; pgx_start_error_watch(pgx); pgx->expose_gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCGraphicsExposures), &gcv); if(pgx_end_error_watch(pgx) || pgx->expose_gc==NULL) xap_abort(xap, "Failed to allocate a graphical context.\n"); }; /* * If the widget has scroll-bars make sure that they agree with the * window. */ xap_update_clip(w); /* * Prepend the new widget to the list of unassigned widgets to be * used by pgbeg(). */ xap_PrependWidget(w, XAP_FREE_WIDGETS); return; } /*....................................................................... * PGPLOT Widget destructor function. * * Input: * widget Widget The widget whose resources are to be released. */ static void xap_Destroy(Widget widget) { XaPgplotWidget w = (XaPgplotWidget) widget; XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; /* * Remove the device from the appropriate list of PGPLOT Athena widgets. */ xap_RemoveWidget(pgx->name, pgx->state ? XAP_ACTIVE_WIDGETS : XAP_FREE_WIDGETS); /* * Delete the window context descriptor. */ xap->pgx = del_PgxWin(pgx); return; } /*....................................................................... * PGPLOT Widget resize function. * * Input: * widget Widget The widget that is being resized. */ static void xap_Resize(Widget widget) { XaPgplotWidget w = (XaPgplotWidget) widget; xap_update_clip(w); if(XtIsRealized(widget)) { XtCallCallbackList(widget, w->pgplot.resize_callback, (XtPointer *)0); }; } /*....................................................................... * The expose-event handler for PGPLOT widgets. * * Input: * widget Widget The widget that is to be re-drawn. * event XEvent The expose event that invoked the callback. * region Region The area to be re-drawn. */ static void xap_Expose(Widget widget, XEvent *event, Region region) { XaPgplotWidget w = (XaPgplotWidget) widget; XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; pgx_expose(pgx, event); return; } /*....................................................................... * This function is called whenever one or more resource values are * changed, to give the widget a chance to re-configure itself to * reflect the new values. * * Input: * old_widget Widget A copy of the widget before the change was made. * req_widget Widget The same as new_w but with the resources evaluated * by the superclasses. * new_widget Widget The widget with the new values in place. This * is also the output widget so changes made to * this widget will be in the final widget. * args ArgList The resource argument list responsible for the * changes. * num_args Cardinal * The number of arguments in args. * Output: * return Boolean Return True if the widget needs to be re-displayed, * or False if not. */ static Boolean xap_SetValues(Widget old_widget, Widget req_widget, Widget new_widget, ArgList args, Cardinal *num_args) { XaPgplotWidget old_w = (XaPgplotWidget) old_widget; XaPgplotWidget new_w = (XaPgplotWidget) new_widget; XaPgplotPart *old_xap = &old_w->pgplot; XaPgplotPart *new_xap = &new_w->pgplot; Bool redisplay_needed = False; /* * Changes to color resources won't be seen once the widget is * realized. Warn the application writer. */ if(new_xap->min_colors != old_xap->min_colors || new_xap->max_colors != old_xap->max_colors || new_xap->share != old_xap->share || new_w->core.colormap != old_w->core.colormap || new_xap->visual != old_xap->visual) { if(XtIsRealized(new_widget)) XtWarning("XtSetValues (XaPgplot): Too late to change color settings.\n"); new_xap->min_colors = old_xap->min_colors; new_xap->max_colors = old_xap->max_colors; new_w->core.colormap = old_w->core.colormap; new_xap->visual = old_xap->visual; }; /* * If the background or foreground colors changed, convert them to * RGB values and instantiate the new definitions. Note that keeping * and using RGB values rather than the pixel value is important * because we may not yet have created the window or its final colormap, * in which case the pixel will correspond to the wrong colormap. The * RGB values are used hereafter by xap_open_widget(). */ if(new_w->core.background_pixel != old_w->core.background_pixel) { XColor *bg = &new_xap->bg; XtVaGetValues(new_widget, XtVaTypedArg, XtNbackground, XtRColor, bg, sizeof(*bg), NULL); pgx_set_background(new_xap->pgx, bg); }; if(new_w->pgplot.fgpixel != old_w->pgplot.fgpixel) { XColor *fg = &new_xap->fg; XtVaGetValues(new_widget, XtVaTypedArg, XtNforeground, XtRColor, fg, sizeof(*fg), NULL); pgx_set_foreground(new_xap->pgx, fg); }; /* * Change the margins? */ if(new_xap->pad_x != old_xap->pad_x || new_xap->pad_y != old_xap->pad_y) pgx_set_margin(new_xap->pgx, new_xap->pad_x, new_xap->pad_y); return redisplay_needed; } /*....................................................................... * Whenever the parent widget wishes to resize a PGPLOT widget, this * function is called to give the widget a chance to veto or otherwise * modify the requested new geometry. * * Input: * widget Widget The widget wrt which the geometry change * pertains. * request XtWidgetGeometry * The requested widget geometry. * Input/Output: * reply XtWidgetGeometry * The returned allowed widget geometry. * Output: * return XtGeometryResult Return status from: * XtGeometryYes * The requested geometry is acceptible. * XtGeometryAlmost * An acceptible revision of the requested * geometry has been encoded in *reply. * XtGeometryNo * The requested geometry is identical * to the existing geometry. */ static XtGeometryResult xap_Query_Geometry(Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *reply) { /* * Tell the parent which attributes we are interested in * and set them to their current values until otherwise * requested. */ reply->request_mode = CWWidth | CWHeight; reply->width = widget->core.width; reply->height = widget->core.height; /* * Check the requested width. */ if(request->request_mode & CWWidth) { reply->width = request->width < XAP_MIN_WIDTH ? XAP_MIN_WIDTH : request->width; }; /* * Check the requested height. */ if(request->request_mode & CWHeight) { reply->height = request->height < XAP_MIN_HEIGHT ? XAP_MIN_HEIGHT : request->height; }; /* * Determine the appropriate reply. */ if((request->request_mode & (CWWidth | CWHeight)) == (CWWidth | CWHeight) && request->width == reply->width && request->height == reply->height) return XtGeometryYes; else if(reply->width == widget->core.width && reply->height == widget->core.height) return XtGeometryNo; else return XtGeometryAlmost; } /*....................................................................... * This function is called to abort the application after a fatal * error occurs. It doesn't return. * * Input: * xap XaPgplotPart * The PGPLOT part of the widget instance structure. * msg char * An error message to abort with, or NULL. */ static void xap_abort(XaPgplotPart *xap, char *msg) { XtAppError(xap->app, msg ? msg : "Aborting"); } /*....................................................................... * Find an inactive PGPLOT widget of a given name, open it to PGPLOT, * and move it to the head of the active list of widgets. * * Input: * name char * The name of the widget to be opened. * Output: * w XaPgplotWidget The selected widget, or NULL on error. */ static XaPgplotWidget xap_open_widget(char *name) { XaPgplotWidget w; /* The PGPLOT widget to be opened */ /* * Remove the named widget from the free-widget list. */ w = xap_RemoveWidget(name, XAP_FREE_WIDGETS); if(!w) { fprintf(stderr, "%s: Request to open non-existent widget (%s).\n", XAP_IDENT, name ? name : "(null)"); return NULL; }; /* * Pre-pend the widget to the active list. */ xap_PrependWidget(w, XAP_ACTIVE_WIDGETS); /* * Open the connection to the PgxWin library. */ pgx_open(w->pgplot.pgx); if(!w->pgplot.pgx->state) xap_close_widget(name); /* * Reset the background and foreground colors to match the current * X resource values. */ pgx_set_background(w->pgplot.pgx, &w->pgplot.bg); pgx_set_foreground(w->pgplot.pgx, &w->pgplot.fg); /* * Allow for margins. */ pgx_set_margin(w->pgplot.pgx, w->pgplot.pad_x, w->pgplot.pad_y); /* * Reset its scroll-bars. */ return w; } /*....................................................................... * Find an active PGPLOT widget of a given name, close it to PGPLOT and * move it to the head of the inactive list of widgets. * * Input: * name char * The name of the widget. * Output: * return XaPgplotWidget The selected widget, or NULL if not found. */ static XaPgplotWidget xap_close_widget(char *name) { XaPgplotWidget w; /* * Remove the widget from the active list. */ w = xap_RemoveWidget(name, XAP_ACTIVE_WIDGETS); if(!w) { fprintf(stderr, "%s: Request to close non-existent widget (%s).\n", XAP_IDENT, name ? name : "(null)"); return NULL; }; /* * Remove cursor handler. */ xap_DisarmCursor(w); /* * Close the connection to the PgxWin library. */ pgx_close(w->pgplot.pgx); /* * Invalidate the pgslct() id. The next time that the widget is opened * to PGPLOT a different value will likely be used. */ w->pgplot.pgslct_id = 0; /* * Prepend the widget to the free list. */ xap_PrependWidget(w, XAP_FREE_WIDGETS); return w; } /*....................................................................... * Lookup a widget by name from a given list of widgets. * * Input: * name char * The name of the widget. * type int The enumerated name of the list to search, * from: * XAP_ACTIVE_WIDGETS * XAP_FREE_WIDGETS * Output: * prev XaPgplotWidget * *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return XaPgplotWidget The located widget, or NULL if not found. */ static XaPgplotWidget xap_FindWidgetByName(char *name, int type, XaPgplotWidget *prev) { XaPgplotList *widget_list; /* The list to be searched */ widget_list = xap_WidgetList(type); if(widget_list && name) { XaPgplotWidget last = NULL; XaPgplotWidget node = widget_list->head; for( ; node; last = node, node = node->pgplot.next) { if(strcmp(node->pgplot.pgx->name, name)==0) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup a widget by its PGPLOT id from a given list of widgets. * * Input: * xaslct_id int The number used by PGPLOT to select the * device. * type int The enumerated name of the list to search, * from: * XAP_ACTIVE_WIDGETS * XAP_FREE_WIDGETS * Output: * prev XaPgplotWidget * *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return XaPgplotWidget The located widget, or NULL if not found. */ static XaPgplotWidget xap_FindWidgetByID(int xaslct_id, int type, XaPgplotWidget *prev) { XaPgplotList *widget_list; /* The list to be searched */ widget_list = xap_WidgetList(type); if(widget_list) { XaPgplotWidget last = NULL; XaPgplotWidget node = widget_list->head; for( ; node; last = node, node = node->pgplot.next) { if(xaslct_id == node->pgplot.xaslct_id) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup one of the PGPLOT class widget lists by its enumerated type. * * Input: * type int The enumerated name of the list, from: * XAP_ACTIVE_WIDGETS * XAP_FREE_WIDGETS * Output: * return XaPgplotList * The widget list, or NULL if not recognized. */ static XaPgplotList *xap_WidgetList(int type) { switch(type) { case XAP_ACTIVE_WIDGETS: return &xaPgplotClassRec.pgplot_class.active_widgets; case XAP_FREE_WIDGETS: return &xaPgplotClassRec.pgplot_class.free_widgets; default: fprintf(stderr, "xap_WidgetList: No such list.\n"); }; return NULL; } /*....................................................................... * Remove a given widget from one of the PGPLOT class widget lists. * * Input: * name char * The name of the widget to be removed from * the list. * type int The enumerated name of the list from which to * remove the widget, from: * XAP_ACTIVE_WIDGETS * XAP_FREE_WIDGETS * Output: * return XaPgplotWidget The removed widget, or NULL if not found. */ static XaPgplotWidget xap_RemoveWidget(char *name, int type) { XaPgplotList *widget_list; /* The list to remove the widget from */ XaPgplotWidget w = NULL; /* The widget being removed */ XaPgplotWidget prev; /* The widget preceding w in the list */ /* * Get the widget list. */ widget_list = xap_WidgetList(type); if(widget_list) { w = xap_FindWidgetByName(name, type, &prev); if(w) { if(prev) { prev->pgplot.next = w->pgplot.next; } else { widget_list->head = w->pgplot.next; }; w->pgplot.next = NULL; }; }; return w; } /*....................................................................... * Prepend a PGPLOT widget to a given PGPLOT class widget list. * * Input: * w XaPgplotWidget The widget to add to the list. * type int The enumerated name of the list to add to, * from: * XAP_ACTIVE_WIDGETS * XAP_FREE_WIDGETS * Output: * return XaPgplotWidget The added widget (the same as w), or NULL * on error. */ static XaPgplotWidget xap_PrependWidget(XaPgplotWidget w, int type) { XaPgplotList *widget_list; /* The list to prepend the widget to */ /* * Get the widget list. */ widget_list = xap_WidgetList(type); if(widget_list) { w->pgplot.next = widget_list->head; widget_list->head = w; }; return w; } /*....................................................................... * Return the currently selected PGPLOT device. * * Input: * context char * If no XaPgplot device is currently selected * and context!=NULL then, an error message of * the form printf("%s: ...\n", context) will * be written to stderr reporting that no * device is open. * Output: * return XaPgplotWidget The currently selected PGPLOT device, or * NULL if no device is currently selected. */ static XaPgplotWidget xap_CurrentWidget(char *context) { XaPgplotWidget w = xaPgplotClassRec.pgplot_class.active_widgets.head; if(w) { /* * We need a window. */ if(!XtIsRealized((Widget)w)) { if(context) { fprintf(stderr, "%s: PGPLOT widget \"%s\" is not realized.\n", context, w->pgplot.pgx->name); }; w = NULL; }; } else { if(context) fprintf(stderr, "%s: No /xa device is currently selected.\n", context); }; return w; } /*....................................................................... * This is the only external entry point to the /xa device driver. * It is called by PGPLOT to open, perform operations on, return * information about and close /xathena windows. * * Input: * ifunc int * The PGPLOT operation code to be executed. * Input/output: * rbuf float * A general buffer for input/output of float values. * nbuf int * Where relevant this is used to return the number of * elements in rbuf[]. Also used on input to specify * number of pixels in the line-of-pixels primitive. * chr char * A general buffer for string I/O. * lchr int * Where relevant this is used to send and return the * number of significant characters in chr. * Input: * len int Added to the call line by the FORTRAN compiler. * This contains the declared size of chr[]. */ #ifdef VMS void xadriv(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void XADRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif /* * Get the active widget if there is one. */ XaPgplotWidget w = xap_CurrentWidget(NULL); XaPgplotPart *xap = w ? &w->pgplot : NULL; PgxWin *pgx = xap ? xap->pgx : NULL; int i; /* * Flush buffered opcodes. */ pgx_pre_opcode(pgx, *ifunc); /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { char *dev_name = "XATHENA (X window widget_name/xa)"; strncpy(chr, dev_name, len); *lchr = strlen(dev_name); for(i = *lchr; i < len; i++) chr[i] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = -1.0; /* Report no effective max plot width */ rbuf[2] = 0.0; rbuf[3] = -1.0; /* Report no effective max plot height */ rbuf[4] = 0.0; rbuf[5] = (pgx && !pgx->bad_device) ? pgx->color->ncol-1 : 1; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: pgx_get_resolution(pgx, &rbuf[0], &rbuf[1]); rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'I'; /* Interactive device */ chr[1] = 'X'; /* Cursor is available and opcode 27 is desired */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines */ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ chr[7] = 'N'; /* Don't prompt on pgend */ chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10]= 'S'; /* Area-scroll available */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: chr[0] = '\0'; /* Default name is "" */ *lchr = 0; break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: pgx_def_size(pgx, XAP_DEF_WIDTH, XAP_DEF_HEIGHT, rbuf, nbuf); break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: { XaPgplotWidget new_w = xap_FindWidgetByID((int)(rbuf[1]+0.5), XAP_ACTIVE_WIDGETS, NULL); if(new_w) { new_w->pgplot.pgslct_id = (int) (rbuf[0]+0.5); xap_RemoveWidget(new_w->pgplot.pgx->name, XAP_ACTIVE_WIDGETS); xap_PrependWidget(new_w, XAP_ACTIVE_WIDGETS); } else { fprintf(stderr, "%s: [Select plot] No such open device.\n", XAP_IDENT); }; }; break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: /* * Assign the returned device unit number and success indicator. * Assume failure to open until the workstation is open. */ rbuf[0] = rbuf[1] = 0.0; *nbuf = 2; /* * Prepare the display name. */ if(*lchr >= len) { fprintf(stderr, "%s: Widget name too long.\n", XAP_IDENT); return; } else { chr[*lchr] = '\0'; }; /* * Get the requested widget from the free widget list. */ w = xap_open_widget(chr); if(!w) return; rbuf[0] = w->pgplot.xaslct_id; /* The number used to select this device */ rbuf[1] = 1.0; *nbuf = 2; break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: /* * Remove the device from the list of open devices. */ if(pgx) xap_close_widget(pgx->name); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: pgx_begin_picture(pgx, rbuf); break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: pgx_draw_line(pgx, rbuf); break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: pgx_draw_dot(pgx, rbuf); break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: pgx_set_ci(pgx, (int) (rbuf[0] + 0.5)); break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: pgx_flush(pgx); break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: if(w) { xap_DisarmCursor(w); if(!XtIsManaged((Widget)w)) XtManageChild((Widget)w); }; pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr); break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ /* (Not implemented: no alpha screen) */ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ /* (Not implemented: should not be called) */ case 19: break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: pgx_poly_fill(pgx, rbuf); break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: pgx_set_rgb(pgx, (int)(rbuf[0]+0.5), rbuf[1],rbuf[2],rbuf[3]); break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: pgx_set_lw(pgx, rbuf[0]); break; /*--- IFUNC=23, Escape --------------------------------------------------*/ /* (Not implemented: ignored) */ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: pgx_rect_fill(pgx, rbuf); break; /*--- IFUNC=25, ---------------------------------------------------------*/ /* (Not implemented: ignored) */ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: pgx_pix_line(pgx, rbuf, nbuf); break; /*--- IFUNC=27, World-coordinate scaling --------------------------------*/ case 27: pgx_set_world(pgx, rbuf); break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: pgx_get_rgb(pgx, rbuf, nbuf); break; /*--- IFUNC=30, Scroll rectangle ----------------------------------------*/ case 30: pgx_scroll_rect(pgx, rbuf); break; /*--- IFUNC=?, ----------------------------------------------------------*/ default: fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n", XAP_IDENT, *ifunc); *nbuf = -1; break; }; return; } /*....................................................................... * This function is called upon by the pgxwin toolkit whenever the * pixmap used as backing store needs to be resized. * * Input: * pgx PgxWin * The pgxwin toolkit context descriptor. * width unsigned The desired new pixmap width. * height unsigned The desired new pixmap height. */ static void xap_NewPixmap(PgxWin *pgx, unsigned width, unsigned height) { pgx_new_pixmap(pgx, width, height); return; } /*....................................................................... * This function provides an asynchronous alternative to pgband() and * pgcurs(). It creates an event handler which ensures that the X cursor * is augmented with selected rubber-band graphics when visible, and * which calls a specified user cursor-input callback when the user * presses a key or button over the window. As with pgband() all * specified and reported coordinates are world coordinates. The * cursor is automatically disarmed in xadriv() if the pgband() opcode * is invoked. It is also disarmed when the pgplot close-workstation * opcode is invoked. * * Input: * widget Widget The PGPLOT widget to connect a cursor to. * mode int The type of cursor augmentation (see XaPgplot.h). * xref,yref float The world-coordinate reference point for band-type * cursors. * callback XtCallbackProc The callback function to call when input events * are received. * client_data void * Client-specific data to be sent to the callback * function. * Output: * return int 0 - OK. * 1 - Error. */ int xap_arm_cursor(Widget widget, int mode, float xref, float yref, XtCallbackProc callback, void *client_data) { XaPgplotWidget w = (XaPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xap_arm_cursor: NULL widget.\n"); return 1; }; /* * Make sure that the widget is currently open to PGPLOT. */ if(w->pgplot.pgslct_id == 0) { fprintf(stderr, "xap_arm_cursor: The widget is not open to PGPLOT.\n"); return 1; }; /* * Delegate the work to an internal function. */ return xap_ArmCursor(w, mode, xref, yref, callback, client_data); } /*....................................................................... * Erase the cursor, remove input callbacks and remove the cursor * event handler. * * Input: * widget Widget The PGPLOT widget to disconnect the cursor from. * Output: * return int 0 - OK. * 1 - Error. */ int xap_disarm_cursor(Widget widget) { if(!widget) { fprintf(stderr, "xap_disarm_cursor: NULL widget intercepted.\n"); return 1; }; return xap_DisarmCursor((XaPgplotWidget)widget); } /*....................................................................... * This is the cursor event handler registered by xap_arm_cursor(). */ static void xap_CursorHandler(Widget widget, XtPointer client_data, XEvent *event, Boolean *cont) { XaPgplotWidget w = (XaPgplotWidget) widget; XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; float rbuf[2]; char key; /* * Handle the event. */ if(pgx_cursor_event(pgx, event, rbuf, &key) && xap->input.callback) { XapCursorCallbackStruct call_data; pgx_dev2world(pgx, rbuf); call_data.x = rbuf[0]; call_data.y = rbuf[1]; call_data.key = key; (*xap->input.callback)(widget, (XtPointer) xap->input.client_data, (XtPointer) &call_data); }; /* * Handle errors. */ if(pgx->bad_device) { *cont = False; xap_DisarmCursor(w); } else { *cont = True; }; return; } /*....................................................................... * The private work-horse function of xap_arm_cursor(). Note that * this function takes an XaPgplotWidget argument whereas xap_arm_cursor() * takes a generic Widget argument. * * Input: * w XaPgplotWidget The PGPLOT widget to connect a cursor to. * mode int The type of cursor augmentation (see XaPgplot.h). * xref,yref float The world-coordinate reference point for band-type * cursors. * callback XtCallbackProc The callback function to call when input events * are received, or 0 if keyboard and button * events are to be handled externally. * client_data void * Client-specific data to be sent to the callback * function. * Output: * return int 0 - OK. * 1 - Error. */ static int xap_ArmCursor(XaPgplotWidget w, int mode, float xref, float yref, XtCallbackProc callback, void *client_data) { Widget widget = (Widget) w; XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; float rbuf[2]; /* * Remove any existing cursor. */ xap_DisarmCursor(w); /* * Convert xref, yref from world coordinates to device coordinates. */ rbuf[0] = xref; rbuf[1] = yref; pgx_world2dev(pgx, rbuf); /* * Raise the cursor. */ if(pgx_set_cursor(pgx, -1, mode, 0, rbuf, rbuf)) return 1; /* * If the pointer is currently in the window, record its position * and draw the cursor. */ if(pgx_locate_cursor(pgx)) pgx_draw_cursor(pgx); /* * Assemble the cursor-hander event-mask. */ xap->input.mask = EnterWindowMask | LeaveWindowMask | PointerMotionMask; /* * Only select for keyboard and button input if a callback was * provided. */ if(callback) xap->input.mask |= KeyPressMask | ButtonPressMask; /* * Record the callback and its data. */ xap->input.callback = callback; xap->input.client_data = client_data; /* * Register an event handler to handle asychronous cursor input. */ XtAddEventHandler(widget, xap->input.mask, False, xap_CursorHandler, (XtPointer) 0); /* * Make sure that the widget is visible. */ if(!XtIsManaged(widget)) XtManageChild(widget); return 0; } /*....................................................................... * The private work-horse function of xap_disarm_cursor(). Note that * this function takes an XaPgplotWidget argument whereas * xap_disarm_cursor() takes a generic Widget argument. * * w XaPgplotWidget The widget to disconnect the cursor from. * Output: * return int 0 - OK. * 1 - Error. */ static int xap_DisarmCursor(XaPgplotWidget w) { if(w) { XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; /* * Do nothing if the cursor is inactive. */ if(xap->input.mask == NoEventMask) return 0; /* * Remove the current event handler. */ XtRemoveEventHandler((Widget) w, xap->input.mask, False, xap_CursorHandler, (XtPointer) 0); /* * Remove the callback function and its data. */ xap->input.callback = 0; xap->input.client_data = NULL; /* * Erase the cursor. */ if(pgx_erase_cursor(pgx) || pgx_set_cursor(pgx, 0, PGX_NORM_CURSOR, 0, NULL, NULL)) return 1; }; return 0; } /*....................................................................... * Get the visual and colormap for a new window as specified by X * resource values. * * Input: * w XaPgplotWidget The PGPLOT widget. * Output: * return int 0 - OK. * 1 - Error. */ static int xap_new_visual(XaPgplotWidget w) { XaPgplotPart *xap = &w->pgplot; PgxWin *pgx = xap->pgx; /* * Allocate colors from parent visual and colormap? */ if(xap->visual == CopyFromParent || w->core.colormap == CopyFromParent) { /* * Find the first parent widget that has a window. */ Widget parent = (Widget) w; do { parent = XtParent(parent); } while(parent && XtWindow(parent)==None); if(!parent) { fprintf(stderr, "xap_new_visual: No parent window found.\n"); return 1; }; /* * Locate the visual and colormap of the parent and allocate colors from them. */ if(!pgx_window_visual(pgx, XtWindow(parent), xap->min_colors, xap->max_colors, xap->share)) return 1; } /* * Allocate colors from a specified colormap and visual. */ else { if(!pgx_adopt_visual(pgx, XVisualIDFromVisual(xap->visual), w->core.colormap, xap->min_colors, xap->max_colors, xap->share)) return 1; }; /* * Record what kind of colors were actually allocated. */ xap->share = xap->pgx->color->readonly; return 0; } /*....................................................................... * Return an unambiguous PGPLOT device-specification that can be used * as the FILE argument of cpgbeg() to open a given PGPLOT widget. * * Input: * widget Widget The PGPLOT widget to return a device string for. * Output: * return char * The PGPLOT device-specication. Note that the returned * string is owned by the widget driver and must not be * free()d or overwritten. */ char *xap_device_name(Widget widget) { if(!widget || XtClass(widget) != xaPgplotWidgetClass) { fprintf(stderr, "xap_device_name: Not a Athena PGPLOT widget.\n"); return "/null"; }; return ((XaPgplotWidget) widget)->pgplot.device; } /*....................................................................... * Return the pgslct_id of the given widget. This can then be used with * the cpgslct() function to select the widget as the currently * active widget. * * Input: * widget Widget The PGPLOT widget to return a device string for. * Output: * return int The PGPLOT device-id. This will be 0 if the widget * is not currently open to PGPLOT. */ int xap_device_id(Widget widget) { if(!widget || XtClass(widget) != xaPgplotWidgetClass) { fprintf(stderr, "xap_device_name: Not a Athena PGPLOT widget.\n"); return 0; } else { XaPgplotWidget w = (XaPgplotWidget) widget; if(w->pgplot.pgslct_id <= 0) { fprintf(stderr, "xap_device_id: The specified widget is not currently open to PGPLOT.\n"); }; return w->pgplot.pgslct_id; }; } /*....................................................................... * The following is a convenience none-variadic function for creating * a PGPLOT widget. Note that XtManageChild() should be applied to the * returned widget. * * Input: * parent Widget The parent widget to adopt. * name char * The name to give the widget. * arglist ArgList A list of X resources. * argcount Cardinal The number of X resources. * Output: * return Widget The new PGPLOT widget. */ Widget XaCreatePgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount) { return XtCreateWidget(name, xaPgplotWidgetClass, parent, arglist, argcount); } /*....................................................................... * Update the clip-area of the window to prevent pgxwin functions from * drawing over the highlight-borders. * * Input: * w XaPgplotWidget The pgplot widget instance. */ static void xap_update_clip(XaPgplotWidget w) { (void) pgx_update_clip(w->pgplot.pgx, 1, w->core.width, w->core.height, 0 ); } /*....................................................................... * This function is a XtResourceDefaultProc function used to return * the default background color. It is used to initialize the * XtNbackground resource. */ static void xap_GetDefaultBackgroundColor(Widget widget, int offset, XrmValue *value) { static Pixel pixel; pixel = BlackPixel(XtDisplay(widget),XScreenNumberOfScreen(XtScreen(widget))); value->addr = (XtPointer) &pixel; } /*....................................................................... * This function is a XtResourceDefaultProc function used to return * the default foreground color. It is used to initialize the * XtNforeground resource. */ static void xap_GetDefaultForegroundColor(Widget widget, int offset, XrmValue *value) { static Pixel pixel; pixel = WhitePixel(XtDisplay(widget),XScreenNumberOfScreen(XtScreen(widget))); value->addr = (XtPointer) &pixel; } /*....................................................................... * This is an application-level utility function for converting from * PGPLOT world coordinates to X-window pixel coordinates. * * Input: * widget Widget The PGPLOT widget whose coordinates are to be * converted. * wx, wy float The PGPLOT world coordinates to be converted. * Output: * px, py int * On output, *px and *py will be assigned with the * X-window pixel coordinates that correspond to wx,wy. * return int 0 - OK. * 1 - Error. */ int xap_world_to_pixel(Widget widget, float wx, float wy, int *px, int *py) { XaPgplotWidget w = (XaPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xap_world_to_pixel: NULL widget.\n"); return 1; }; /* * Delegate the conversion to an internal function. */ return xap_WorldToPixel(w, wx, wy, px, py); } /*....................................................................... * This is an application-level utility function for converting from * X-window pixel coordinates to PGPLOT world coordinates. * * Input: * widget Widget The PGPLOT widget whose coordinates are to be * converted. * px, py int * The X-window pixel coordinates to be converted. * Output: * wx, wy float * On output, *wx and *wy will be assigned with the * PGPLOT world coordinates that correspond to px,py. * return int 0 - OK. * 1 - Error. */ int xap_pixel_to_world(Widget widget, int px, int py, float *wx, float *wy) { XaPgplotWidget w = (XaPgplotWidget) widget; /* * Check the arguments. */ if(!widget) { fprintf(stderr, "xap_pixel_to_world: NULL widget.\n"); return 1; }; /* * Delegate the conversion to an internal function. */ return xap_PixelToWorld(w, px, py, wx, wy); } /*....................................................................... * This is an internal function for converting from X-window pixel * coordinates to PGPLOT world coordinates. * * Input: * w XaPgplotWidget The widget whose coordinates are to be converted. * px, py int * The X-window pixel coordinates to be converted. * Output: * wx, wy float * On output, *wx and *wy will be assigned with the * PGPLOT world coordinates that correspond to px,py. * return int 0 - OK. * 1 - Error. */ static int xap_PixelToWorld(XaPgplotWidget w, int px, int py, float *wx, float *wy) { PgxWin *pgx = w->pgplot.pgx; float rbuf[2]; /* * Convert the specified pixel coordinates to world coordinates. */ pgx_win2dev(pgx, px, py, rbuf); pgx_dev2world(pgx, rbuf); /* * Assign the return values if possible. */ if(wx) *wx = rbuf[0]; if(wy) *wy = rbuf[1]; return 0; } /*....................................................................... * This is an internal function for converting from PGPLOT world * coordinates to X-window pixel coordinates. * * Input: * w XaPgplotWidget The widget whose coordinates are to be converted. * wx, wy float The PGPLOT world coordinates to be converted. * Output: * px, py int * On output, *px and *py will be assigned with the * X-window pixel coordinates that correspond to wx,wy. * return int 0 - OK. * 1 - Error. */ static int xap_WorldToPixel(XaPgplotWidget w, float wx, float wy, int *px, int *py) { PgxWin *pgx = w->pgplot.pgx; float rbuf[2]; /* * Convert the world coordinate to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; pgx_world2dev(pgx, rbuf); pgx_dev2win(pgx, rbuf, px, py); return 0; } data. */ xap->input.callback = callback; xap->input.client_data = client_data; /* * Register an event handler to handle asychronous cursor input. */ XtAddEventHandler(widget, xap->input.mask, False, xap_CursorHandler, (XtPointer) 0); /* * Make sure that the widget is visible. */ if(!XtIsManaged(widget)) XtManageChild(widget); return 0; } /*....................................................................... * Thpgplot/drivers/xathena/XaPgplot.h010064400040640000322000000071040650071354000175510ustar00tjpcitmbr00000400000017#ifndef XaPgplot_h #define XaPgplot_h #ifdef __cplusplus extern "C" { #endif /* * Define resource-name constants. */ #define XapNminColors "minColors" #define XapCMinColors "MinColors" #define XapNmaxColors "maxColors" #define XapCMaxColors "MaxColors" #define XapNpadX "padX" #define XapCPadX "PadX" #define XapNpadY "padY" #define XapCPadY "PadY" #define XapNshare "share" #define XapCShare "Share" #define XAP_NORM_CURSOR 0 /* Un-augmented X cursor */ #define XAP_LINE_CURSOR 1 /* Line cursor between ref and pointer */ #define XAP_RECT_CURSOR 2 /* Rectangular cursor between ref and pointer */ #define XAP_YRNG_CURSOR 3 /* Two horizontal lines, at ref.x and pointer.x */ #define XAP_XRNG_CURSOR 4 /* Two vertical lines, at ref.y and pointer.y */ #define XAP_HLINE_CURSOR 6 /* Horizontal line cursor at y=ref.y */ #define XAP_VLINE_CURSOR 5 /* Vertical line cursor at x=ref.x */ #define XAP_CROSS_CURSOR 7 /* Cross-hair cursor centered on the pointer */ /* * When a cursor-input callback [previously registered using xap_arm_cursor()] * is called by the widget, the position of the cursor and the key * that the user pressed are recorded in a struct of the following * form. A pointer to this struct is then cast to (XtPointer) and * passed as the 'call_data' argument of the callback function. The * callback function should cast this argument back to * (XapCursorCallbackStruct *) in order to access its fields. */ typedef struct { float x,y; /* The world-coordinate position of the cursor */ char key; /* The key pressed by the user (Mouse buttons='A','D','X') */ } XapCursorCallbackStruct; int xap_arm_cursor(Widget widget, int mode, float xref, float yref, XtCallbackProc callback, void *client_data); int xap_disarm_cursor(Widget widget); /* * Record the official PGPLOT device name of the widget driver. */ #define XAP_DEVICE "XATHENA" /* * The following function returns an unambiguous PGPLOT device-specification * that can be used as the FILE argument of cpgbeg() to open a given PGPLOT * widget. It simply returns a string composed of the widget name, followed * by a "/" followed by XAP_DEVICE. Note that the returned string is owned * by the widget and must not be free()d or overwritten. */ char *xap_device_name(Widget widget); /* * After a widget has been opened to PGPLOT (via pgopen or pgbeg), the * following function can be used to return the PGPLOT id of the device. * When multiple PGPLOT devices are open this id can then be used with * the PGPLOT cpgslct() function to select the widget as the currently * selected PGPLOT graphics device. * * If the specified widget has not been opened to pgplot, or has been * closed and not re-opened, then 0 will be returned. */ int xap_device_id(Widget widget); /* * The following global is a pointer to the shared class context * descriptor and is what is passed to XtCreateManagedWidget() * to tell it what type of widget to create. */ externalref WidgetClass xaPgplotWidgetClass; /* * Declare opaque aliases to the widget class and instance structures. */ typedef struct XaPgplotClassRec *XaPgplotWidgetClass; typedef struct XaPgplotRec *XaPgplotWidget; /* * Convenience widget creation functions. */ Widget XaCreatePgplot(Widget parent, char *name, ArgList arglist, Cardinal argcount); /* * The following functions allow conversions between PGPLOT world coordinates * and X-window pixel coordinates. */ int xap_pixel_to_world(Widget widget, int px, int py, float *wx, float *wy); int xap_world_to_pixel(Widget widget, float wx, float wy, int *px, int *py); #ifdef __cplusplus } #endif #endif pgplot/drivers/xathena/XaPgplotP.h010064400040640000322000000071000650071361000176630ustar00tjpcitmbr00000400000017#ifndef XaPgplotP_h #define XaPgplotP_h #include #define XtNresizeCallback "resizeCallback" #define XtCResizeCallback "ResizeCallback" #include "XaPgplot.h" #include "pgxwin.h" /* * Declare a container for a list of widgets. */ typedef struct { XaPgplotWidget head; /* The head of the list of widgets */ } XaPgplotList; /* * Declare the structure that will contain class-specific * attributes. These are effectively shared by all instances * of the class widgets. */ typedef struct XaPgplotClassPart { int widget_id_counter; /* Used to give widgets unique numeric identifiers */ XaPgplotList active_widgets; /* List of active widgets */ XaPgplotList free_widgets; /* List of unnassigned widgets */ XtPointer *extension; /* Unused extension field */ } XaPgplotClassPart; /* * Collect all class-specific parts from superclasses and the current * new class. */ typedef struct XaPgplotClassRec { CoreClassPart core_class; SimpleClassPart simple_class; XaPgplotClassPart pgplot_class; } XaPgplotClassRec; externalref XaPgplotClassRec xaPgplotClassRec; /* * A context descriptor for dispatching pointer input events. */ typedef struct { unsigned long mask; /* The current cursor event-mask */ XtCallbackProc callback; /* The cursor-event client callback, or 0 */ void *client_data; /* Client data to be sent to the callback */ } XapInput; /* * Now declare a structure to contain the instance specific parts of * the class. This contains members that are different from one * instance of the widget class to the next. */ typedef struct XaPgplotPart { /* Public resource attributes */ int max_colors; /* The max number of colors needed */ int min_colors; /* The min number of colors needed */ Colormap colormap; /* The default colormap to use */ Visual *visual; /* The default visual to use */ XtCallbackList resize_callback; /* User resize-window callbacks */ Dimension pad_x; /* The number of pixels to assign to the optional */ /* margin either side of the viewsurface */ Dimension pad_y; /* The number of pixels to assign to the optional */ /* margin above and below the viewsurface */ Boolean share; /* Non-zero to allocate shared color cells */ /* Private attributes */ XaPgplotWidget next; /* The next widget of a list of PGPLOT Motif widgets */ int xaslct_id; /* The device ID returned to PGPLOT by the */ /* open-workstation driver opcode, and used for */ /* subsequent device selection via the */ /* select-plot driver opcode */ int pgslct_id; /* The device ID returned to the application by */ /* pgopen() for subsequent device selection with */ /* the pgslct() function */ char *device; /* A possible PGPLOT cpgbeg() file string */ XtAppContext app; /* The application context */ XapInput input; /* Cursor input callback and client data container */ Pixel fgpixel; /* In the athena port, we have nowhere to store this otherwise */ XColor bg, fg; /* The RGB values of the current foreground and */ /* background colors. The pixel member is ignored. */ PgxWin *pgx; /* PGPLOT generic X-window context descriptor */ } XaPgplotPart; /* * Collect the instance structures of the super-classes and the * PGPLOT class. */ typedef struct XaPgplotRec { CorePart core; SimplePart simple; XaPgplotPart pgplot; } XaPgplotRec; #endif pgplot/drivers/xathena/pgawdemo.c010064400040640000322000001234120650071571100176140ustar00tjpcitmbr00000400000017#include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "XaPgplot.h" #include "cpgplot.h" /* * Make the demo backwardly compatible with older versions of X. */ #if XtSpecificationRelease <= 4 #define XtSetLanguageProc(a,b,c) (void)((a),(b),(c)) #endif /* * Gray-scale images of multiple analytic 2D functions will be supported. * Each 2D function will be encapsulated in a C function of the * following type. */ #define IMAGE_FN(fn) float (fn)(float x, float y) /* * Define a macro for prototyping and defining XtCallbackProc functions. */ #define CALL_FN(fn) void (fn)(Widget w, XtPointer client_data, XtPointer call_data) /* * List the prototypes of the available 2D-function functions. */ static IMAGE_FN(sinc_fn); static CALL_FN(sinc_callback); static IMAGE_FN(gaus_fn); static CALL_FN(gaus_callback); static IMAGE_FN(ring_fn); static CALL_FN(ring_callback); static IMAGE_FN(sin_angle_fn); static CALL_FN(sin_angle_callback); static IMAGE_FN(cos_radius_fn); static CALL_FN(cos_radius_callback); static IMAGE_FN(star_fn); static CALL_FN(star_callback); /* Color table menu callbacks */ static CALL_FN(grey_callback); static CALL_FN(rainbow_callback); static CALL_FN(heat_callback); static CALL_FN(aips_callback); /* Set the default image size */ enum {MAP_SIZE=129}; /* Set the number of points plotted per slice */ enum {SLICE_SIZE=100}; /* * Declare a type to hold a single X,Y coordinate. */ typedef struct { float x, y; /* World coordinates */ } Vertex; /* * Declare the object type that will contain the context of the * image and slice plots. */ typedef struct { Widget w_coord; /* Coordinate-display label widget */ Widget w_image; /* The gray-scale image widget */ Widget w_slice; /* The slice-plot image widget */ float *image; /* The gray-scale image array */ float *slice; /* The slice compilation array */ float scale; /* Coversion factor pixels -> coords */ int image_size; /* The number of pixels along each side of the image */ int slice_size; /* The length of the slice array */ int xa,xb; /* Min and max X pixel coordinates */ int ya,yb; /* Min and max Y pixel coordinates */ float datamin; /* The minimum data value in image[] */ float datamax; /* The maximum data value in image[] */ IMAGE_FN(*fn); /* The function to be displayed */ Vertex va; /* The start of the latest slice line */ Vertex vb; /* The end of the latest slice line */ Widget w_top; /* The top-level widget of the application */ Cursor busy; /* The cursor to display when un-responsive */ } Image; /* * Image object contructor and destructor functions. */ static Image *new_Image(unsigned image_size, unsigned slice_size, IMAGE_FN(*fn), Widget parent, Widget w_top); static Image *del_Image(Image *im); /* * Image and slice display functions. */ static void display_fn(Image *im, IMAGE_FN(*fn)); static void display_image(Image *im, int id); static void display_slice(Image *im, Vertex *va, Vertex *vb); static void display_help(Image *im); static void recolor_image(Image *im, float *lev, float *r, float *g, float *b, int n); /* * The following structure is used to describe menu fields to * CreateOptionMenu() and CreatePulldownMenu(). * Note that title options are denoted by setting callback=NULL, * and that separators are specified by setting label=NULL. */ typedef struct { char *label; /* The MenuItem label text */ XtCallbackProc callback; /* Function to be called when field is selected */ } MenuItem; static Widget CreateOptionMenu(char *name, char *label, Widget parent, int nopt, MenuItem *opts, XtPointer client_data); static Widget CreatePulldownMenu(char *name, char *label, Widget parent, int nfield, MenuItem *fields, XtPointer client_data); static void PopulateMainMenuBar( Image *im, Widget w_bar ); void centerWidgetAndMouse(Widget widget, Widget pwidget, Widget mwidget); static Widget XawDialogGetText( Widget dialog ); static Widget GetTopShell( Widget w ); static CALL_FN(set_label_callback); static Widget CreatePopupPromptDialog(Widget w, char *name, char *prompt, char *value, XtCallbackProc ok_fn, XtPointer ok_data); static void start_slice_callback(Widget w, XtPointer client_data, XtPointer call_data); static void end_slice_callback(Widget w, XtPointer client_data, XtPointer call_data); static CALL_FN(quit_callback); static CALL_FN(help_callback); static CALL_FN(save_image_as_callback); static CALL_FN(save_image_callback); static CALL_FN(destroy_widget_callback); static void report_cursor(Widget w, XtPointer context, XEvent *event, Boolean *call_next); /*....................................................................... * A demo program showing an example of how to use PGPLOT with Athena. * * Output: * return int 0 - OK. * 1 - Error. */ int main(int argc, char *argv[]) { XtAppContext app;/* Application context returned by XtVaAppInitialize */ Widget w_top; /* The top-level widget of the application */ Widget w_main; /* The geometry management widget of the application */ Widget w_bar; /* The menubar of the application */ Image *im; /* Image object container */ /* * Initialize Xt. */ XtSetLanguageProc(NULL, NULL, NULL); w_top = XtVaAppInitialize(&app, "ImageSlice", NULL, 0, #if XtSpecificationRelease <= 4 (Cardinal *) #endif &argc, argv, NULL, NULL); w_main = XtVaCreateWidget("main", panedWidgetClass, w_top, XtNheight, 760, XtNwidth, 420, NULL); /* * Create a placeholder for the menubar */ w_bar = XtVaCreateWidget("menuBar", formWidgetClass, w_main, XtNshowGrip, False, XtNskipAdjust, True, NULL); /* * Create the two PGPLOT widgets and the image container object. */ im = new_Image(MAP_SIZE, SLICE_SIZE, ring_fn, w_main, w_top); if (!im) return 1; /* * Create the application menu-bar. */ PopulateMainMenuBar(im, w_bar); XtManageChild(w_bar); XtManageChild(w_main); /* * Display the widgets. */ XtRealizeWidget(w_top); /* * Open the widgets to PGPLOT. */ if (cpgopen(xap_device_name(im->w_image)) <= 0 || cpgopen(xap_device_name(im->w_slice)) <= 0) return 1; /* * Display the initial image. */ display_fn(im, ring_fn); /* * Interact with the user. */ XtAppMainLoop(app); return 0; } /*....................................................................... * Allocate and return an initialized Image container object. * This function creates two PGPLOT widgets. One will be used to display * a gray-scale image. The other will be used to display a slice through * the image. * * Note that the widgets are not opened to PGPLOT and nothing * will be displayed until display_fn() is first * called. These operations must be postponed until after the widgets have * been realized. * * Input: * image_size unsigned The number of pixels along each side of the * square image array. This must be an odd * number (so that there can be a central pixel). * slice_size unsigned The dimension of the slice array (>=2). * fn IMAGE_FN(*) The initial display function. * parent Widget The widget in which to create the PGPLOT widgets. * w_top Widget The top-level widget of the application. * Output: * return Image * The new image container, or NULL on error. */ static Image *new_Image(unsigned image_size, unsigned slice_size, IMAGE_FN(*fn), Widget parent, Widget w_top) { Image *im; /* The pointer to the container to be returned */ Widget w_frame; /* A frame widget */ int i; /* * Check the arguments. */ if(image_size < 1 || image_size % 2 == 0) { fprintf(stderr, "new_Image: Illegal image size requested.\n"); return NULL; }; if(slice_size < 2) { fprintf(stderr, "new_Image: Illegal slice size requested.\n"); return NULL; }; if(!fn) { fprintf(stderr, "new_Image: NULL display function intercepted.\n"); return NULL; }; /* * Allocate the container. */ im = (Image *) malloc(sizeof(Image)); if(!im) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return NULL; }; /* * Before attempting any operation that might fail, initialize the * Image container at least up to the point at which it can safely be * passed to del_Image(). */ im->w_coord = NULL; im->w_image = NULL; im->w_slice = NULL; im->image = NULL; im->slice = NULL; im->image_size = image_size; im->slice_size = slice_size; im->scale = 40.0f/image_size; im->xa = -(int)image_size/2; im->xb = image_size/2; im->ya = -(int)image_size/2; im->yb = image_size/2; im->fn = fn; im->busy = None; im->w_top = w_top; /* * Now allocate the 2D image array as a 1D array to be indexed in * as a FORTRAN array. */ im->image = (float *) malloc(sizeof(float) * image_size * image_size); if(!im->image) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return del_Image(im); }; /* * Initialize the image array. */ for(i=0; iimage[i] = 0.0f; /* * Allocate an array to be used when constructing slices through the * displayed image. */ im->slice = (float *) malloc(sizeof(float) * slice_size); if(!im->slice) { fprintf(stderr, "new_Image: Insufficient memory.\n"); return del_Image(im); }; /* * Initialize the slice array. */ for(i=0; islice[i] = 0.0f; /* * Create a horizontal row-column widget in which to arrange the * coordinate-display labels. */ w_frame = XtVaCreateManagedWidget("coord_form", formWidgetClass, parent, NULL); /* * Create two labels. The first will contain a prefix, and the second * will contain the coordinates. */ { char *text = "World coordinates: "; Widget w_clab = XtVaCreateManagedWidget("clab", labelWidgetClass, w_frame, XtNlabel, text, XtNleft, XawChainLeft, XtNright, XawChainLeft, NULL); im->w_coord = XtVaCreateManagedWidget("coord", labelWidgetClass, w_frame, XtNlabel, "", XtNfromHoriz, w_clab, XtNleft, XawChainLeft, XtNright, XawChainRight, NULL); }; /* * Create an etched-in frame widget to provide a border for the * image window. */ w_frame = XtVaCreateManagedWidget("image_frame", viewportWidgetClass, parent, XtNallowHoriz, True, XtNallowVert, True, NULL); /* * Create the image-display widget. */ im->w_image = XtVaCreateManagedWidget("image", xaPgplotWidgetClass, w_frame, XtNheight, 400, XtNwidth, 400, XapNmaxColors, 50, XapNshare, True, NULL); /* * Register a motion-event callback such that the cursor position can * be reported in the im->w_coord label widget. */ XtAddEventHandler(im->w_image, PointerMotionMask, False, report_cursor, (XtPointer)im->w_coord); /* * Create a pulldown menu of optional 2-D image functions. */ { static MenuItem functions[] = { {"Display Functions", NULL}, /* Title */ {NULL, NULL}, /* Separator */ {"R=Polar radius", NULL}, /* Label */ {"A=Polar angle", NULL}, /* Label */ {NULL, NULL}, /* Separator */ {"cos(R)sin(A)", ring_callback}, {"sinc(R)", sinc_callback}, {"exp(-R^2/20.0)", gaus_callback}, {"sin(A)", sin_angle_callback}, {"cos(R)", cos_radius_callback}, {"(1+sin(6A))exp(-R^2/100)", star_callback}, }; Widget menu = CreateOptionMenu("functions", "Select a display function:", parent, sizeof(functions)/sizeof(functions[0]), functions, (XtPointer) im); if(menu == NULL) return del_Image(im); XtManageChild(menu); }; /* * Create a pulldown menu of optional color tables. */ { static MenuItem tables[] = { {"Color Tables", NULL}, /* Title */ {NULL, NULL}, /* Separator */ {"grey", grey_callback}, {"rainbow", rainbow_callback}, {"heat", heat_callback}, {"aips", aips_callback}, }; Widget menu = CreateOptionMenu("Colors", "Select a color table:", parent, sizeof(tables)/sizeof(tables[0]), tables, (XtPointer) im); if(menu == NULL) return del_Image(im); XtManageChild(menu); }; /* * Create an etched-in frame widget to provide a border for the * slice-plot window. */ w_frame = XtVaCreateManagedWidget("image_frame", viewportWidgetClass, parent, XtNallowHoriz, True, XtNallowVert, True, NULL); /* * Create the slice-display widget. */ im->w_slice = XtVaCreateManagedWidget("slice", xaPgplotWidgetClass, w_frame, XtNheight, 200, XtNwidth, 400, XapNmaxColors, 16, XapNshare, True, NULL); /* * Get the standard X busy cursor. */ im->busy = XCreateFontCursor(XtDisplay(im->w_top), XC_watch); return im; } /*....................................................................... * Delete an Image container previously returned by new_Image(). * * Input: * im Image * The container to be deleted (or NULL). * Output: * return Image * The deleted container (always NULL). */ Image *del_Image(Image *im) { if(im) { if(im->image) free(im->image); if(im->w_coord) XtDestroyWidget(im->w_coord); if(im->w_image) XtDestroyWidget(im->w_image); if(im->w_slice) XtDestroyWidget(im->w_slice); if(im->busy != None) XFreeCursor(XtDisplay(im->w_top), im->busy); free(im); }; return NULL; } /*....................................................................... * Display a new function in the image window. * * Input: * im Image * The image context object. * fn IMAGE_FN(*) The function to be displayed. */ static void display_fn(Image *im, IMAGE_FN(*fn)) { int ix, iy; /* The pixel coordinates being assigned */ float vmin; /* The minimum pixel value in the image */ float vmax; /* The maximum pixel value in the image */ float *pixel;/* A pointer to pixel (ix,iy) in im->image */ /* * Check arguments. */ if(!fn) { fprintf(stderr, "display_fn: NULL function.\n"); return; }; /* * Disarm the cursor while the image-plot is incomplete. */ xap_disarm_cursor(im->w_image); /* * Install the new function. */ im->fn = fn; /* * Fill the image array via the current display function. */ pixel = im->image; vmin = vmax = im->fn(im->xa * im->scale, im->ya * im->scale); for(iy = im->ya; iy <= im->yb; iy++) { for(ix = im->xa; ix <= im->xb; ix++) { float value = im->fn(ix * im->scale, iy * im->scale); *pixel++ = value; if(value < vmin) vmin = value; if(value > vmax) vmax = value; }; }; /* * Record the min and max values of the data array. */ im->datamin = vmin; im->datamax = vmax; /* * Display the new image. */ display_image(im, xap_device_id(im->w_image)); /* * Arm the cursor for user selection of the start position of the * first slice line through this image. */ xap_arm_cursor(im->w_image, XAP_NORM_CURSOR, 0.0f, 0.0f, start_slice_callback, im); /* * Display instructions in the slice window. */ display_help(im); return; } /*....................................................................... * Display the current image function in a specified PGPLOT device. * * * Input: * im Image * The image context object. * id int The id of the PGPLOT device to display. */ static void display_image(Image *im, int id) { int minind,maxind; /* The range of available color indexes */ float tr[6]; /* Image coordinate-transformation matrix */ /* * Since rendering a gray-scale image takes a few seconds * display the busy cursor. */ XDefineCursor(XtDisplay(im->w_top), XtWindow(im->w_top), im->busy); XFlush(XtDisplay(im->w_top)); /* * Select the specified PGPLOT device and display the image array. */ cpgslct(id); cpgask(0); cpgpage(); cpgsch(1.0f); cpgvstd(); cpgwnad(im->xa * im->scale, im->xb * im->scale, im->ya * im->scale, im->yb * im->scale); /* * Set up the pixel -> world coordinate transformation matrix. */ tr[0] = (im->xa - 1) * im->scale; tr[1] = im->scale; tr[2] = 0.0f; tr[3] = (im->ya - 1) * im->scale; tr[4] = 0.0f; tr[5] = im->scale; /* * If there are fewer than 2 colors available for plotting images, * mark the image as monochrome so that pggray can be asked to * produce a stipple version of the image. */ cpgqcir(&minind, &maxind); if(maxind-minind+1 <= 2) { cpggray(im->image, im->image_size, im->image_size, 1, im->image_size, 1, im->image_size, im->datamax, im->datamin, tr); } else { cpgimag(im->image, im->image_size, im->image_size, 1, im->image_size, 1, im->image_size, im->datamin, im->datamax, tr); }; cpgsci(1); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("X", "Y", "Image display demo"); /* * Revert to the normal X cursor. */ XDefineCursor(XtDisplay(im->w_top), XtWindow(im->w_top), None); return; } /*....................................................................... * Display a new slice in the slice window. * * Input: * im Image * The image context object. * va Vertex * The vertex of one end of the slice line. * vb Vertex * The vertex of the opposite end of the slice line. */ static void display_slice(Image *im, Vertex *va, Vertex *vb) { float xa; /* The start X value of the slice */ float dx; /* The X-axis world-coordinate width of one slice pixel */ float ya; /* The start Y value of the slice */ float dy; /* The Y-axis world-coordinate width of one slice pixel */ float smin = HUGE ;/* The minimum slice value */ float smax = -HUGE;/* The maximum slice value */ float slice_length; /* The world-coordinate length of the slice */ float ymargin; /* The Y axis margin within the plot */ int i; /* * Determine the slice pixel assignments. */ xa = va->x; dx = (vb->x - va->x) / im->slice_size; ya = va->y; dy = (vb->y - va->y) / im->slice_size; /* * Make sure that the slice has a finite length by setting a * minimum size of one pixel. */ { float min_delta = im->scale / im->slice_size; if(fabs(dx) < min_delta && fabs(dy) < min_delta) dx = min_delta; }; /* * Construct the slice in im->slice[] and keep a tally of the * range of slice values seen. */ for(i=0; islice_size; i++) { float value = im->fn(xa + i * dx, ya + i * dy); im->slice[i] = value; if(i==0) { smin = smax = value; } else if(value < smin) { smin = value; } else if(value > smax) { smax = value; }; }; /* * Determine the length of the slice. */ { float xlen = dx * im->slice_size; float ylen = dy * im->slice_size; slice_length = sqrt(xlen * xlen + ylen * ylen); }; /* * Determine the extra length to add to the Y axis to prevent the * slice plot hitting the top and bottom of the plot. */ ymargin = 0.05 * (im->datamax - im->datamin); /* * Set up the slice axes. */ cpgslct(xap_device_id(im->w_slice)); cpgask(0); cpgpage(); cpgbbuf(); cpgsch(2.0f); cpgvstd(); cpgswin(0.0f, slice_length, im->datamin - ymargin, im->datamax + ymargin); cpgbox("BCNST", 0.0f, 0, "BCNST", 0.0f, 0); cpglab("Radius", "Image value", "A 1D slice through the image"); /* * Draw the slice. */ for(i=0; islice_size; i++) { if(i==0) cpgmove(0.0f, im->slice[0]); else cpgdraw(slice_length * (float)i / (float)im->slice_size, im->slice[i]); }; cpgebuf(); return; } /*....................................................................... * Display usage instructions in the slice window. * * Input: * im Image * The image object. */ static void display_help(Image *im) { /* * Clear the slice plot and replace it with instructional text. */ cpgslct(xap_device_id(im->w_slice)); cpgask(0); cpgpage(); cpgsch(3.5f); cpgsvp(0.0, 1.0, 0.0, 1.0); cpgswin(0.0, 1.0, 0.0, 1.0); cpgmtxt("T", -2.0, 0.5, 0.5, "To see a slice through the image, move the"); cpgmtxt("T", -3.0, 0.5, 0.5, "mouse into the image display window and select"); cpgmtxt("T", -4.0, 0.5, 0.5, " the two end points of a line."); } /*....................................................................... * A sinc(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sinc_fn) { const float tiny = 1.0e-6f; float radius = sqrt(x*x + y*y); return (fabs(radius) < tiny) ? 1.0f : sin(radius)/radius; } /*....................................................................... * Callback to select the sinc_fn() fucntion. */ static CALL_FN(sinc_callback) { display_fn((Image *) client_data, sinc_fn); } /*....................................................................... * A exp(-(x^2+y^2)/20) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(gaus_fn) { return exp(-((x*x)+(y*y))/20.0f); } /*....................................................................... * Callback to select the gaus_fn() fucntion. */ static CALL_FN(gaus_callback) { display_fn((Image *) client_data, gaus_fn); } /*....................................................................... * A cos(radius)*sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(ring_fn) { return cos(sqrt(x*x + y*y)) * sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * Callback to select the ring_fn() fucntion. */ static CALL_FN(ring_callback) { display_fn((Image *) client_data, ring_fn); } /*....................................................................... * A sin(angle) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(sin_angle_fn) { return sin(x==0.0f && y==0.0f ? 0.0f : atan2(x,y)); } /*....................................................................... * Callback to select the sin_angle_fn() fucntion. */ static CALL_FN(sin_angle_callback) { display_fn((Image *) client_data, sin_angle_fn); } /*....................................................................... * A cos(radius) function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(cos_radius_fn) { return cos(sqrt(x*x + y*y)); } /*....................................................................... * Callback to select the cos_radius_fn() fucntion. */ static CALL_FN(cos_radius_callback) { display_fn((Image *) client_data, cos_radius_fn); } /*....................................................................... * A (1+sin(6*angle))*exp(-radius^2 / 100)function. * * Input: * x,y float The coordinates to evaluate the function at. * Output: * return float The function value at the specified coordinates. */ static IMAGE_FN(star_fn) { return (1.0 + sin(x==0.0f && y==0.0f ? 0.0f : 6.0*atan2(x,y))) * exp(-((x*x)+(y*y))/100.0f); } /*....................................................................... * Callback to select the star_fn() fucntion. */ static CALL_FN(star_callback) { display_fn((Image *) client_data, star_fn); } /*....................................................................... * Create an option menu. * * Input: * name char * The name of the menu. * label char * The instructive label to place to the left of * the option menu. * parent Widget The widget in which to place the option menu. * nopt int The number of option fields. * opts MenuItem * An array of nopt option fields. * client_data XtPointer The client_data argument to be passed to each * callback function. * Output: * return Widget The menu, or NULL on error. */ static Widget CreatePulldownMenu( char *name, char *label, Widget parent, int nopt, MenuItem *opts, XtPointer client_data ) { Widget w_menu; /* The option menu to be returned */ Widget w_pulldown; /* The pulldown-menu of the option menu widget */ int i; static char buf[100]; char* menuName; /* * Check arguments. */ if (nopt < 1 || !opts) { fprintf(stderr, "CreateOptionMenu: No options.\n"); return NULL; }; sprintf(buf, "%sMenu", name); /* Menuname */ menuName = XtNewString(buf); /* * Create a menuButton */ w_menu = XtVaCreateManagedWidget(name, menuButtonWidgetClass, parent, XtNlabel, label, XtNmenuName, menuName, NULL); /* * Create a pulldown menu. */ w_pulldown = XtVaCreatePopupShell(menuName, simpleMenuWidgetClass, w_menu, NULL); /* * Install the option fields. */ for (i=0; ilabel) { /* * Add an option field. */ if (opt->callback) { Widget widget = XtVaCreateManagedWidget(opt->label, smeBSBObjectClass, w_pulldown, NULL); XtAddCallback(widget, XtNcallback, opt->callback, client_data); } else { /* * Add a title widget. */ XtVaCreateManagedWidget(opt->label, smeBSBObjectClass, w_pulldown, NULL); }; } else { /* * Add a separator widget. */ XtVaCreateManagedWidget("separator", smeLineObjectClass, w_pulldown, NULL); }; }; return w_menu; } static Widget CreateOptionMenu( char *name, char *label, Widget parent, int nopt, MenuItem *opts, XtPointer client_data ) { Widget w_form; /* The container widget for the option menu */ Widget w_label; /* Label for the line */ Widget w_menu; /* The option menu to be returned */ Widget w_pulldown; /* The pulldown-menu of the option menu widget */ int i; static char buf[100]; char* menuName; Boolean first = True; /* * Check arguments. */ if (nopt < 1 || !opts) { fprintf(stderr, "CreateOptionMenu: No options.\n"); return NULL; }; sprintf(buf, "%sMenu", name); /* Menuname */ menuName = XtNewString(buf); /* * Create container */ w_form = XtVaCreateManagedWidget(name, formWidgetClass, parent, XtNskipAdjust, True, XtNshowGrip, False, NULL); /* * Create a label */ w_label = XtVaCreateManagedWidget(label, labelWidgetClass, w_form, XtNleft, XawChainLeft, XtNright, XawChainLeft, NULL); /* * Create a menuButton */ w_menu = XtVaCreateManagedWidget(name, menuButtonWidgetClass, w_form, XtNmenuName, menuName, XtNfromHoriz, w_label, XtNleft, XawChainLeft, XtNright, XawChainLeft, XtNresizable, True, NULL); /* * Create a pulldown menu. */ w_pulldown = XtVaCreatePopupShell(menuName, simpleMenuWidgetClass, w_menu, NULL); /* * Install the option fields. */ for (i=0; ilabel) { /* * Set label of Menubutton */ if (first) { first = False; XtVaSetValues(w_menu, XtNlabel, opt->label, NULL); } /* * Add an option field. */ if (opt->callback) { Widget widget = XtVaCreateManagedWidget(opt->label, smeBSBObjectClass, w_pulldown, NULL); XtAddCallback(widget, XtNcallback, opt->callback, client_data); XtAddCallback(widget, XtNcallback, set_label_callback, (XtPointer)w_menu); } else { /* * Add a title widget. */ XtVaCreateManagedWidget(opt->label, smeBSBObjectClass, w_pulldown, NULL); }; } else { /* * Add a separator widget. */ XtVaCreateManagedWidget("separator", smeLineObjectClass, w_pulldown, NULL); }; }; return w_menu; } static void set_label_callback( Widget w, XtPointer client_data, XtPointer call_data ) { Widget w_menu = (Widget)client_data; char* label; XtVaGetValues(w, XtNlabel, &label, NULL); XtVaSetValues(w_menu, XtNlabel, label, NULL); } /*....................................................................... * This callback is called when the user selects the start position * of a slice line. * * Input: * Widget widget The PGPLOT widget that had a cursor event. * client_data XtPointer The optional client data pointer passed to * xap_arm_cursor(). * call_data XtPointer The pointer to the context of the event * as a (XapCursorCallbackStruct *) cast to * (XtPointer). */ static void start_slice_callback(Widget w, XtPointer client_data, XtPointer call_data) { XapCursorCallbackStruct *cursor = (XapCursorCallbackStruct *) call_data; Image *im = (Image *) client_data; im->va.x = cursor->x; im->va.y = cursor->y; /* * Display a line-oriented rubber-band cursor to get the end vertex of the * line. */ cpgslct(xap_device_id(im->w_image)); cpgsci(3); xap_arm_cursor(im->w_image, XAP_LINE_CURSOR, im->va.x, im->va.y, end_slice_callback, im); } /*....................................................................... * This callback is called when the user selects the end position * of a slice line. * * Input: * Widget widget The PGPLOT widget that had a cursor event. * client_data XtPointer The optional client data pointer passed to * xap_arm_cursor(). * call_data XtPointer The pointer to the context of the event * as a (XapCursorCallbackStruct *) cast to * (XtPointer). */ static void end_slice_callback(Widget w, XtPointer client_data, XtPointer call_data) { XapCursorCallbackStruct *cursor = (XapCursorCallbackStruct *) call_data; Image *im = (Image *) client_data; im->vb.x = cursor->x; im->vb.y = cursor->y; /* * Re-arm the cursor for the start of the next line. */ xap_arm_cursor(im->w_image, XAP_NORM_CURSOR, 0.0f, 0.0f, start_slice_callback, im); /* * Draw the slice wrt the new line. */ display_slice(im, &im->va, &im->vb); } /*....................................................................... * Create the menu bar of the application. * * Input: * im Image * The image object of the application. * w_main Widget The form widget for the menubar */ static void PopulateMainMenuBar( Image *im, Widget w_bar ) { Widget file; /* The file menu-button */ /* * Install the File menu. */ { static MenuItem file_fields[] = { {"Save image as", save_image_as_callback}, {NULL, NULL}, /* Separator */ {"Quit", quit_callback} }; file = CreatePulldownMenu("file_menu", "File", w_bar, XtNumber(file_fields), file_fields, (XtPointer) im); XtVaSetValues(file, XtNleft, XawChainLeft, XtNright, XawChainLeft, NULL); }; /* * Install the Help menu. */ { static MenuItem help_fields[] = { {"Usage", help_callback} }; Widget w_help = CreatePulldownMenu("help_menu", "Help", w_bar, XtNumber(help_fields), help_fields, (XtPointer) im); XtVaSetValues(w_help, XtNleft, XawChainRight, XtNright, XawChainRight, XtNfromHoriz, file, NULL); }; } /*....................................................................... * The file-menu "Quit" callback function. */ static CALL_FN(quit_callback) { exit(0); } /*....................................................................... * The help-menu callback function. */ static CALL_FN(help_callback) { Image *im = (Image *) client_data; display_help(im); } /*....................................................................... * The File-menu "save image as" callback. */ static CALL_FN(save_image_as_callback) { Image *im = (Image *) client_data; Widget w_dialog = CreatePopupPromptDialog(w, "device", "Enter a PGPLOT device string:", "image.ps/vps ", save_image_callback, (XtPointer) im); /* * Add a null translation for the letter '?'. This prevents users from * enterring a PGPLOT '?' query string. */ { char *bindings ="s \?:"; XtTranslations translations = XtParseTranslationTable(bindings); XtOverrideTranslations(XawDialogGetText(w_dialog), translations); }; /* * Display the dialog. */ XtManageChild(w_dialog); XtPopup(XtParent(w_dialog), XtGrabNone); } /*....................................................................... * The callback for the dialog created by save_image_as_callback(). */ static CALL_FN(save_image_callback) { int device_id; /* The PGPLOT ID of the new PGPLOT device */ Image *im = (Image *) client_data; Widget dialog = XtParent(w); /* * Get device specification. */ { char *device = XawDialogGetValueString(dialog); if( device ) { /* * Open the specified device. */ device_id = cpgopen(device); if (device_id > 0) { display_image(im, device_id); cpgclos(); }; } }; /* * Discard the popup widget. */ XtDestroyWidget(GetTopShell(w)); return; } /*....................................................................... * Create a popup prompt-dialog with a specified prompt and initial value. * * Input: * w Widget The widget of the button that invoked the dialog. * name char * The name to give the popup. Note that * XaCreatePromptDialog() appends _prompt to this. * prompt char * The dialog prompt string. * value char * The initial value to display, or NULL. * ok_fn XtCallbackProc The callback function for the OK button. * ok_data XtPointer The callback client_data argument. * Output: * return Widget The dialog widget. */ static Widget CreatePopupPromptDialog( Widget w, char *name, char *prompt, char *value, XtCallbackProc ok_fn, XtPointer ok_data ) { Widget w_dialog; /* The dialog widget to be returned */ Widget shell, top, w_text; top = GetTopShell(w); /* * Create the dialog. */ { char buf[100]; sprintf(buf, "%sShell", name); shell = XtVaCreatePopupShell(buf, transientShellWidgetClass, top, NULL); w_dialog = XtVaCreateManagedWidget(name, dialogWidgetClass, shell, XtNlabel, prompt, XtNvalue, value ? value : "", NULL); w_text = XawDialogGetText(w_dialog); { char* trans = "#override\nReturn: set() notify()\nReturn: unset()"; XtAccelerators accel = XtParseAcceleratorTable(trans); Widget w_button = XtVaCreateManagedWidget("Ok", commandWidgetClass, w_dialog, XtNaccelerators, accel, NULL); XtAddCallback(w_button, XtNcallback, ok_fn, ok_data); XtInstallAccelerators(w_text, w_button); XtInstallAccelerators(w_dialog, w_button); } XawDialogAddButton(w_dialog, "Cancel", destroy_widget_callback, shell); XtVaSetValues(w_text, XtNright, XawChainRight, XtNleft, XawChainLeft, NULL); }; XtRealizeWidget(shell); centerWidgetAndMouse(shell, top, top); return w_dialog; } /*....................................................................... * A callback that destroys its client_data. */ static CALL_FN(destroy_widget_callback) { XtDestroyWidget( (Widget)client_data ); } static Widget XawDialogGetText( Widget dialog ) { return XtNameToWidget(dialog, "value"); } static Widget GetTopShell( Widget w ) { while (w && !XtIsWMShell(w)) w = XtParent(w); return w; } /*....................................................................... * This is a motion-event callback for the image window. It reports the * current position of the cursor in world coordinates. * * Input: * w Widget The im->w_image PGPLOT widget. * context XtPointer The im->w_coord label widget cast to XtPointer. * event XEvent * The motion event. * call_next Boolean * *call_next will be left as True so that any * following event handlers will get called. */ static void report_cursor(Widget w, XtPointer context, XEvent *event, Boolean *call_next) { Widget w_coord = (Widget) context; if(event->type == MotionNotify) { char text[80]; float wx, wy; /* * Convert from X-window coordinates to world coordinates. */ if(xap_pixel_to_world(w, event->xmotion.x, event->xmotion.y, &wx, &wy) == 0) { sprintf(text, "X=%-10g Y=%-10g", wx, wy); XtVaSetValues(w_coord, XtNlabel, text, NULL); }; }; *call_next = True; } /*....................................................................... * Callback to select a grey colormap fucntion. */ static CALL_FN(grey_callback) { static float grey_l[] = {0.0, 1.0}; static float grey_c[] = {0.0, 1.0}; recolor_image((Image *) client_data, grey_l, grey_c, grey_c, grey_c, sizeof(grey_l)/sizeof(grey_l[0])); } /*....................................................................... * Callback to select a rainbow colormap fucntion. */ static CALL_FN(rainbow_callback) { static float rain_l[] = {-0.5, 0.0, 0.17, 0.33, 0.50, 0.67, 0.83, 1.0, 1.7}; static float rain_r[] = { 0.0, 0.0, 0.0, 0.0, 0.6, 1.0, 1.0, 1.0, 1.0}; static float rain_g[] = { 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 0.6, 0.0, 1.0}; static float rain_b[] = { 0.0, 0.3, 0.8, 1.0, 0.3, 0.0, 0.0, 0.0, 1.0}; recolor_image((Image *) client_data, rain_l, rain_r, rain_g, rain_b, sizeof(rain_l)/sizeof(rain_l[0])); } /*....................................................................... * Callback to select the IRAF "heat" colormap fucntion. */ static CALL_FN(heat_callback) { static float heat_l[] = {0.0, 0.2, 0.4, 0.6, 1.0}; static float heat_r[] = {0.0, 0.5, 1.0, 1.0, 1.0}; static float heat_g[] = {0.0, 0.0, 0.5, 1.0, 1.0}; static float heat_b[] = {0.0, 0.0, 0.0, 0.3, 1.0}; recolor_image((Image *) client_data, heat_l, heat_r, heat_g, heat_b, sizeof(heat_l)/sizeof(heat_l[0])); } /*....................................................................... * Callback to select the aips tvfiddle colormap fucntion. */ static CALL_FN(aips_callback) { static float aips_l[] = {0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4, 0.5, 0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9, 1.0}; static float aips_r[] = {0.0, 0.0, 0.3, 0.3, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0}; static float aips_g[] = {0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.8, 0.8, 0.6, 0.6, 1.0, 1.0, 1.0, 1.0, 0.8, 0.8, 0.0, 0.0}; static float aips_b[] = {0.0, 0.0, 0.3, 0.3, 0.7, 0.7, 0.7, 0.7, 0.9, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0}; recolor_image((Image *) client_data, aips_l, aips_r, aips_g, aips_b, sizeof(aips_l)/sizeof(aips_l[0])); } /*....................................................................... * Change the colors used to display the current image. * * Inputs: * im Image * The image widget resource object. * lev float * The array of n normalized brightness levels at which * red,green and blue levels are to be defined. * r float * The red brightness at each of the levels in lev[]. * g float * The green brightness at each of the levels in lev[]. * b float * The blue brightness at each of the levels in lev[]. * n int The number of values in each of lev[],r[],g[] and b[]. */ static void recolor_image(Image *im, float *lev, float *r, float *g, float *b, int n) { Boolean share; /* True if the widget colors are readonly */ /* * Select the image PGPLOT widget and redefine its colors. */ cpgslct(xap_device_id(im->w_image)); cpgctab(lev, r, g, b, n, 1.0, 0.5); /* * If the widget's colors were allocated readonly, redraw the image * to reveal the new colors. */ XtVaGetValues(im->w_image, XapNshare, &share, NULL); if(share) display_image(im, xap_device_id(im->w_image)); } void centerWidgetAndMouse(Widget widget, Widget pwidget, Widget mwidget) /* * Center widget "widget" inside widget "pwidget" and warp mouse to middle * of "mwidget". */ { Arg args[2]; Window rwin, child; int x, y, px, py; unsigned int w, h, pw, ph, bw, d; /* Get child size */ XGetGeometry(XtDisplay(widget), XtWindow(widget), &rwin, &x, &y, &w, &h, &bw, &d); /* Get parent size, position */ XGetGeometry(XtDisplay(pwidget), XtWindow(pwidget), &rwin, &px, &py, &pw, &ph, &bw, &d); /* Need position in root window coords, don't ask me why */ XTranslateCoordinates(XtDisplay(widget), XtWindow(pwidget), rwin, px, py, &x, &y, &child); px = x; py = y; /* Compute child position */ x = px + pw / 2 - w / 2; if (x < 0) x = 0; else if (x > WidthOfScreen(XtScreen(widget)) - w) x = WidthOfScreen(XtScreen(widget)) - w; y = py + ph / 2 - h / 2; if (y < 0) y = 0; else if (y > HeightOfScreen(XtScreen(widget)) - h) y = WidthOfScreen(XtScreen(widget)) - h; /* Set child position */ XtSetArg(args[0], XtNx, x); XtSetArg(args[1], XtNy, y); XtSetValues(widget, args, 2); /* Get dest size, position */ XGetGeometry(XtDisplay(mwidget), XtWindow(mwidget), &rwin, &x, &y, &w, &h, &bw, &d); /* Move mouse there */ XWarpPointer(XtDisplay(mwidget), None, XtWindow(mwidget), 0, 0, 0, 0, w / 2, h / 2); } nRight, XtNright, XawChainRight, XtNfromHoriz, file, NULL); }; } /*....................................................................... * The file-menu "Quit" callback function. */ static CALL_FN(quit_callback) {pgplot/drivers/cgdriv.c010064400040640000322000000476360666657714700157020ustar00tjpcitmbr00000400000017/* * PGPLOT CGM (Computer Graphics Metafile) Driver * Version: 1.0 - 17/12/97 * * Author: Robin Sergeant, Rutherford Appleton Laboratory (Oxfordshire, UK) * Email: rsergeant@clara.net * WWW: http://www.isis.rl.ac.uk/computing/cgmdriv.htm * * Output conforms to version 1 of the CGM specification * * NB Scaling information is ignored by some products (eg MS Word). * However it has been included as some software will take advantage * of this. * */ #define DPI 1000 /* set the resoloution to 1000 dpi */ #define PAGE_WIDTH 7.8 /* set the page width to 7.8 inches */ #define PAGE_HEIGHT 10.5 /* set the page height to 10.5 inches */ typedef unsigned short WORD; typedef unsigned char BYTE; typedef struct rgb { BYTE r; BYTE g; BYTE b; BYTE pad; /* So structure is aligned */ } COLOUR; static int words_bigendian = 0; /* Machine type (1 = Bigendian) */ /* * Certain symbols in fcntl.h may not get defined * unless the _POSIX_SOURCE feature-test macro is set. */ #ifndef _POSIX_SOURCE #define _POSIX_SOURCE #endif #ifdef _WIN32 #define CGDRIV CGDRIV #elif defined(PG_PPU) #define CGDRIV cgdriv_ #else #define CGDRIV cgdriv #endif #include #include #include #include #ifndef convex #include #endif /* * VAX VMS includes etc.. */ #ifdef VMS #include /* sleep() is prototyped here */ #include /* access() is prototyped here */ #include #include #include #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; static int vms_define_command(char *file, char *command); static int vms_spawn_nowait(char *command); #endif #ifndef VMS #include #if defined (HAVE_UNISTD_H) # include #endif /* HAVE_UNISTD_H */ #endif static void pg_colour_setup(COLOUR *c) { int count; c[0].r=255;c[0].g=255;c[0].b=255; /* White (background) */ c[1].r=0;c[1].g=0;c[1].b=0; /* Black (default) */ c[2].r=255;c[2].g=0;c[2].b=0; /* Red */ c[3].r=0;c[3].g=255;c[3].b=0; /* Green */ c[4].r=0;c[4].g=0;c[4].b=255; /* Blue */ c[5].r=0;c[5].g=255;c[5].b=255; /* Cyan (Green + Blue) */ c[6].r=255;c[6].g=0;c[6].b=255; /* Magenta (Red + Blue) */ c[7].r=255;c[7].g=255;c[7].b=0; /* Yellow (Red + Green) */ c[8].r=255;c[8].g=128;c[8].b=0; /* Red + Yellow (Orange) */ c[9].r=128;c[9].g=255;c[9].b=0; /* Green + Yellow */ c[10].r=0;c[10].g=255;c[10].b=128; /* Green + Cyan */ c[11].r=0;c[11].g=128;c[11].b=255; /* Blue + Cyan */ c[12].r=128;c[12].g=0;c[12].b=255; /* Blue + Magenta */ c[13].r=255;c[13].g=0;c[13].b=128; /* Red + Magenta */ c[14].r=84;c[14].g=84;c[14].b=84; /* Dark Gray */ c[15].r=168;c[15].g=168;c[15].b=168; /* Light Gray */ for (count=16;count<256;count++) { c[count].r=0;c[count].g=0;c[count].b=0; /* make the rest Black */ } return; } static int write_byte(FILE *pt,BYTE b) { int error = 0; /* clear error flag */ if (putc(b,pt) == EOF) error = 1; /* set error flag */ return error; } static int write_word(FILE *pt,WORD w) { BYTE *cp; int error; cp=(BYTE*)&w; if (words_bigendian) { write_byte(pt,cp[0]); /* write in big-endian format */ error = write_byte(pt,cp[1]); } else { write_byte(pt,cp[1]); /* write in big-endian format */ error = write_byte(pt,cp[0]); } return error; } static void write_float(FILE *pt,float f) { BYTE *cp; cp=(BYTE*)&f; if (words_bigendian) { write_byte(pt,cp[0]); /* write in big-endian format */ write_byte(pt,cp[1]); write_byte(pt,cp[2]); write_byte(pt,cp[3]); } else { write_byte(pt,cp[3]); /* write in big-endian format */ write_byte(pt,cp[2]); write_byte(pt,cp[1]); write_byte(pt,cp[0]); } return; } static FILE* begin_metafile(const char *filename,const char *name) { int c,length; FILE *pt; length=strlen(name); pt=fopen(filename,"wb"); if (pt == NULL) return pt; if (length < 30) /* use short format if possible */ write_word(pt,(WORD)(0x0020+length+1)); else { write_word(pt,0x003f); write_word(pt,(WORD)(length+1)); } write_byte(pt,(BYTE)length); for (c=0;cdsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void CGDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, len) int *ifunc, *nbuf, *lchr, *mode; int len; float rbuf[]; char *chr; { #endif static FILE *pt; static COLOUR colours[256]; static int width = 1; static int state = 0; /* Device state (1 = open) */ static int picture; /* Picture number */ static int colourMode; /* 0 = indexed, 1 = direct */ static int status = 0; /* Driver status (1 = called) */ colourMode = *mode - 1; if (!status) { /* Check machine type on first call */ WORD test = 0x100; BYTE* cp; cp = (BYTE*)&test; if (cp[0] == 1) { words_bigendian = 1; } status = 1; } switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { const char *dev_name; int c; if (*mode == 1) dev_name = "CGM (CGM file, indexed colour selection mode)"; else dev_name = "CGMD (CGM file, direct colour selection mode)"; *lchr = strlen(dev_name); strncpy(chr, dev_name, len); for (c = *lchr;c<(int)len;c++) chr[c] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = 32767.0; rbuf[2] = 0.0; rbuf[3] = 32767.0; rbuf[4] = 0.0; rbuf[5] = 255.0; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: rbuf[0] = DPI; /* device coordinates per inch */ rbuf[1] = DPI; rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'H'; /* Hardcopy device */ chr[1] = 'N'; /* Cursor is not available */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines available*/ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ chr[7] = 'N'; /* Do not prompt on close */ chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10] = 'N'; /* Not used */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: { const char *file_name; int c; file_name = "pgplot.cgm"; *lchr = strlen(file_name); strncpy(chr, file_name, len); for (c = *lchr;c<(int)len;c++) chr[c] = ' '; } break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: rbuf[0] = 0.0; rbuf[1] = PAGE_WIDTH * DPI; rbuf[2] = 0.0; rbuf[3] = PAGE_HEIGHT * DPI; *nbuf = 4; break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: { const char *name = "PGPLOT CGM File"; const char *desc = "$Revision: 1.19 $"; char *filename; if (state == 1) { /* only allow one device */ printf("CGMDRIV:Error a CGM file is already open\n"); rbuf[1] = 0.0; /* error while opening device */ return; } filename = (char*)malloc(*lchr * sizeof(char) + 1); strncpy(filename, chr, *lchr); filename[*lchr] = '\0'; pt = begin_metafile(filename, name); free(filename); if (pt != NULL) { state = 1; picture = 0; pg_colour_setup(colours); metafile_version(pt); metafile_description(pt,desc); real_precision(pt,0,9,23); /* set to 32-bit floating point */ metafile_element_list(pt); rbuf[0] = 1.0; rbuf[1] = 1.0; /* no error */ } else rbuf[1] = 0.0; /* error while opening device */ *nbuf = 2; } break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: state = 0; end_metafile(pt); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: { int c; char name[60]; picture++; sprintf(name,"Picture %d",picture); begin_picture(pt,name); colour_selection_mode(pt,colourMode); line_width_specification_mode(pt,0); vdc_extent(pt,0x0000,0x0000,(WORD)(rbuf[0]+0.5),(WORD)(rbuf[1]+0.5)); scaling_mode(pt,0.0254F); /* 1 VDC pixel = 0.0254mm or 1/1000" */ begin_picture_body(pt); interior_style(pt,1); if (colourMode == 0) /* add colour table entries if needed */ { for (c=0;c<16;c++) colour_table(pt,(BYTE)c,colours[c].r,colours[c].g,colours[c].b); } } break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: line(pt,(WORD)(rbuf[0]+0.5),(WORD)(rbuf[1]+0.5),(WORD)(rbuf[2]+0.5),(WORD)(rbuf[3]+0.5)); break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: circle(pt,(WORD)(rbuf[0]+0.5),(WORD)(rbuf[1]+0.5),(WORD)width); break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: end_picture(pt); break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: { int i = (int)(rbuf[0]+0.5); line_colour(pt,colourMode,(BYTE)i,colours); fill_colour(pt,colourMode,(BYTE)i,colours); } break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: *nbuf = -1; break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ case 19: *nbuf = -1; break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: { static int n = 0; /* set no. of points to 0 (no polygon) */ static int c; static WORD *points; if (n==0) { /* first call for this polygon? */ n = (int)(rbuf[0]+0.5)*2; /* if so, set n and allocate memory */ c = 0; /* point counter */ points = (WORD*)malloc(sizeof(WORD)*n); } else { points[c] = (WORD)(rbuf[0]+0.5); /* add points to array */ points[c+1] = (WORD)(rbuf[1]+0.5); if (c==n-2) { /* final set of points? */ polygon(pt,points,n); /* if so, create polygon */ n = 0; free(points); } else c = c+2; } } break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: { int i = (int)(rbuf[0]+0.5); colours[i].r = (int)(255*rbuf[1]+0.5); /* convert from rgb scales to rgb values */ colours[i].g = (int)(255*rbuf[2]+0.5); colours[i].b = (int)(255*rbuf[3]+0.5); if (colourMode == 0) /* add colour table entry if needed */ colour_table(pt,(BYTE)i,colours[i].r,colours[i].g,colours[i].b); } break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: width = (int)(rbuf[0]*0.005*DPI+0.5); if (width == 0) width = 1; line_width(pt,(WORD)width); break; /*--- IFUNC=23, Escape --------------------------------------------------*/ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: rectangle(pt,(WORD)(rbuf[0]+0.5),(WORD)(rbuf[1]+0.5),(WORD)(rbuf[2]+0.5),(WORD)(rbuf[3]+0.5)); break; /*--- IFUNC=25, ---------------------------------------------------------*/ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: { int x,y,c,i,oldi,x1; if (width > 1) /* make sure the width is 1 */ line_width(pt,1); x = (int)(rbuf[0]+0.5); /* start co-ordinates */ y = (int)(rbuf[1]+0.5); x1 = 0; /* set line offset to 0 */ oldi = (int)(rbuf[2]+0.5); /* set old colour index to the first */ for (c=0;c<*nbuf-2;c++) { i = (int)(rbuf[c+2]+0.5); if (i != oldi) { /* if colour changed then draw line */ line_colour(pt,colourMode,(BYTE)oldi,colours); line(pt,(WORD)(x+x1),(WORD)y,(WORD)(x+c),(WORD)y); x1 = c; /* reset line offset */ } oldi = i; } line_colour(pt,colourMode,(BYTE)oldi,colours); line(pt,(WORD)(x+x1),(WORD)y,(WORD)(x+c),(WORD)y); /* add final line */ if (width > 1) line_width(pt,(WORD)width); /* reset width if changed above */ } break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: { int i = (int)(rbuf[0]+0.5); rbuf[1] = (float)colours[i].r/255; /* convert from rgb values to rgb scales */ rbuf[2] = (float)colours[i].g/255; rbuf[3] = (float)colours[i].b/255; *nbuf = 4; } break; }; return; } chrdsc, lchr, mode) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptopgplot/drivers/pndriv.c010064400040640000322000000411040667703643700157000ustar00tjpcitmbr00000400000017/* This is the PNG (Portable Network Graphics) driver for PGPLOT. For more information on the PNG standard, and to get the necessary libraries, see http://www.cdrom.com/pub/png/ This driver is intended to be used in the same ways as one would use PGPLOT's GIF driver, and as such uses many of the same conventions. The default plotting dimensions are 850x680, and can be manipulated via the PGPLOT_PNG_WIDTH and PGPLOT_PNG_HEIGHT environment variables. The driver can be opened as many times as the caller likes (i.e., more than one device number available). Associated with each device is a single filename, and after each page advance the filename is modified to have a trailing "_X", where "X" is the current page number. This does not apply to the first page output, however. For compilation, both libpng and zlib must be installed. These libraries are Free Software, and can be obtained at the following URLs: libpng: http://www.cdrom.com/pub/png/ zlib: http://www.cdrom.com/pub/infozip/zlib/ March, 1999 Pete Ratzlaff */ #include #include #include #include #include #ifdef VMS #include #include #endif /* make the driver callable from FORTRAN */ #ifdef PG_PPU #define PNDRIV pndriv_ #else #define PNDRIV pndriv #endif /* Flags passed by grexec(). We may need others in the future. Set in drivers.list. */ #define TRANS_OFF 1 #define TRANS_ON 2 /* miscellaneous constants */ #define DEFAULT_WIDTH 850 #define DEFAULT_HEIGHT 680 #define NCOLORS 256 #define DEVICE_CAPABILITIES "HNNNNRPNYN" #define DEFAULT_FILENAME "pgplot.png" #define boolean unsigned char #define true 1 #define false 0 #define PNG_IDENT_BASIC "PGPLOT /png" /* used in warning messages */ #define PNG_IDENT_TRANS "PGPLOT /tpng" /* used in warning messages */ static char *png_ident; /* should be set each time pndriv() is entered */ /* use for opcode = 1 */ #define DEVICE_NAME_BASIC "PNG (Portable Network Graphics file)" #define DEVICE_NAME_TRANS "TPNG (Portable Network Graphics file - transparent background)" /* simple way of specifiying the current device structure pointer */ #define ACTIVE_DEVICE (all_devices.devices[all_devices.active]) typedef unsigned char ColorComponent; /* red, green, or blue component of a colortable entry */ typedef unsigned char ColorIndex; /* index into a color table */ /* taken from the GIF driver */ static ColorComponent base_colors[] = { 0, 0, 0, 255, 255, 255, 255, 0, 0, 0, 255, 0, 0, 0, 255, 0, 255, 255, 255, 0, 255, 255, 255, 0, 255, 128, 0, 128, 255, 0, 0, 255, 128, 0, 128, 255, 128, 0, 255, 255, 0, 128, 85, 85, 85, 170, 170, 170, }; /* each new device initially copies its colortable from here */ static ColorComponent default_colortable[NCOLORS * 3]; /* data for a single open device */ typedef struct _DeviceData DeviceData, *DeviceDataPtr; struct _DeviceData { int w, h; long npix; /* w*h */ boolean trans; /* transparent background flag */ boolean error; /* if true, we can plot no more on this device */ ColorIndex *pixmap; /* image consisting of array of color indicies */ int npages; /* running total of plot pages */ char *filename; ColorComponent ctable[NCOLORS * 3]; ColorIndex cindex; /* current plotting color index */ int devnum; /* this device's identifier */ }; /* global data holding all devices */ typedef struct _Devices Devices; struct _Devices { DeviceDataPtr *devices; int nallocated; int active; }; static Devices all_devices; /* number of DeviceData structures to allocate at a time */ #define devices_ALLOC_INCREMENT 128 /* copy the default colortable to a newly-opened device's ctable entry */ static void initialize_device_ctable(DeviceData *dev) { memcpy(dev->ctable, default_colortable, 3 * NCOLORS * sizeof(ColorComponent)); } /* use to set the RGB components of a colortable entry */ static void set_color_rep(DeviceData *dev, int index, ColorComponent r, ColorComponent g, ColorComponent b) { dev->ctable[index*3+0] = r; dev->ctable[index*3+1] = g; dev->ctable[index*3+2] = b; } static void get_color_rep(DeviceData *dev, int index, ColorComponent *r, ColorComponent *g, ColorComponent *b) { *r = dev->ctable[index*3+0]; *g = dev->ctable[index*3+1]; *b = dev->ctable[index*3+2]; } /* If one were to port this driver to a new image format, then this is the * only routine that would need to be rewritten. */ static void write_image_file(DeviceData *dev) { int i; char *filename; FILE *fp; png_structp png_ptr; png_infop info_ptr; png_color colors[NCOLORS]; ColorComponent r, g, b; if (dev->error == true) return; /* fill the color table for libpng */ for (i=0; ifilename)+EXTRA_CHARS); if (!filename) { fprintf(stderr,"%s: out of memory, plotting disabled\n", png_ident); dev->error = true; return; } strcpy(filename,dev->filename); if (strcmp("-",filename) != 0 && dev->npages > 1) { sprintf(filename,"%s_%d",dev->filename,dev->npages); fprintf(stderr,"%s: writing new file as %s\n",png_ident,filename); } /* open the file */ if (strcmp("-",filename) != 0) { if (! (fp = fopen(filename,"wb"))) { fprintf(stderr,"%s: could not open file %s for writing, plotting disabled\n",png_ident,filename); dev->error = true; free(filename); return; } } else { fp = stdout; } png_ptr = png_create_write_struct( PNG_LIBPNG_VER_STRING, NULL, NULL, NULL ); info_ptr = png_create_info_struct(png_ptr); if (!info_ptr) { fprintf(stderr,"%s: error in libpng while writing file %s, plotting disabled\n", png_ident, filename); png_destroy_write_struct(&png_ptr, (png_infopp)NULL); dev->error = true; if (fp != stdout) fclose(fp); free(filename); return; } if (setjmp(png_ptr->jmpbuf)) { /* not really sure what I'm doing here... */ fprintf(stderr,"%s: error in libpng while writing file %s, plotting disabled\n", png_ident, filename); png_destroy_write_struct(&png_ptr,&info_ptr); dev->error = true; if (fp != stdout) fclose(fp); free(filename); return; } png_init_io(png_ptr, fp); png_set_IHDR(png_ptr, info_ptr, dev->w, dev->h, 8, PNG_COLOR_TYPE_PALETTE, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT ); png_set_PLTE(png_ptr, info_ptr, colors, NCOLORS); /* text to go in PNG file */ { png_text text[1]; text[0].key = "Software"; text[0].text = "PGPLOT Graphics Subroutine Library"; text[0].text_length = strlen(text[0].text); text[0].compression = PNG_TEXT_COMPRESSION_NONE; png_set_text(png_ptr, info_ptr, text, 1); }; /* set bKGD chunk */ /* not sure I know what image readers will do with this, so it's commented out { png_color_16 background; background.index = 0; png_set_bKGD(png_ptr,info_ptr,&background); } */ /* set transparency */ if (dev->trans == true) { png_byte i = 0; png_set_tRNS(png_ptr, info_ptr, &i, 1, NULL); }; png_write_info(png_ptr, info_ptr); for (i=dev->h-1; i>=0; i--) png_write_row(png_ptr,&dev->pixmap[i * dev->w]); png_write_end(png_ptr, info_ptr); png_destroy_write_struct(&png_ptr, &info_ptr); if (fp != stdout) fclose(fp); free(filename); } static void swap_coords(int *x1, int *y1, int *x2, int *y2) { int tmp; tmp = *x1; *x1 = *x2; *x2 = tmp; tmp = *y1; *y1 = *y2; *y2 = tmp; } static void fill_rectangle( DeviceData *dev, int x1, int y1, int x2, int y2, ColorIndex index ) { int y; int npix = (x2 - x1 + 1); /* number of pixels to fill on a single line */ if (dev->error == true) return; /* ensure coords are lower left and upper right */ if (x2pixmap[ y * dev->w + x1 ], index, npix * sizeof(ColorIndex) ); } /* Begins a new plot page. Allocates memory for the pixmap, which should be freed after the page has been written to file */ static void start_plot(DeviceData *dev, int w, int h) { dev->w = w; dev->h = h; dev->npix = dev->w * dev->h; dev->pixmap = malloc( dev->npix * sizeof(ColorIndex) ); if (!dev->pixmap) { fprintf(stderr,"%s: out of memory, plotting disabled\n",png_ident); dev->error = true; } dev->npages++; fill_rectangle(dev, 0, 0, dev->w-1, dev->h-1, 0); return; } /* Called when page is done. Should write file and free memory allocated in start_plot() for pixmap. */ static void end_plot(DeviceData *dev) { if (dev->error == true) return; write_image_file(dev); free(dev->pixmap); } static void make_device_active(float devnum) { all_devices.active = devnum; if (ACTIVE_DEVICE == NULL) fprintf(stderr,"%s: one SIGSEGV coming right up! ACTIVE_DEVICE == NULL\n",png_ident); } /* Used first time through PNDRIV() */ static void initialize_default_colortable(void) { int i; ColorComponent half_colors[] = { 128, 128, 128 }; memcpy(default_colortable, base_colors, 3 * 16 * sizeof(ColorComponent) ); for (i=16; i 0) || !(*height>0)) { *width = DEFAULT_WIDTH; *height = DEFAULT_HEIGHT; } return; } static void draw_line(DeviceData *dev, int x1, int y1, int x2, int y2, ColorIndex index) { int x, y; float rate; if (dev->error == true) return; if (x1 == x2 || y1 == y2) { /* rate of change calculation below doesn't like this case */ fill_rectangle(dev,x1,y1,x2,y2,index); return; } if (abs(y2-y1) > abs(x2-x1)) { if (y1 > y2) swap_coords(&x1, &y1, &x2, &y2); rate = (x2 - x1) / (float)(y2 - y1); for (y=y1; ypixmap[ y * dev->w + x ] = index; } } else { if (x1 > x2) swap_coords(&x1, &y1, &x2, &y2); rate = (float)(y2 - y1) / (float)(x2 - x1); for (x=x1; xpixmap[ y * dev->w + x ] = index; } } } /* set a single pixel's color */ static void fill_pixel(DeviceData *dev, int x, int y, ColorIndex index) { if (dev->error == true) return; dev->pixmap[ y * dev->w + x ] = index; } static void initialize_all_devices(void) { all_devices.devices = NULL; all_devices.nallocated = 0; all_devices.active = -1; } static void open_new_device(char *file, int length, float *id, float *err, int mode) { DeviceDataPtr *tmp; int i; int devnum = -1; /* find an empty slot */ for (i=0; i= all_devices.nallocated) { tmp = realloc(all_devices.devices, sizeof(DeviceDataPtr) * (all_devices.nallocated + devices_ALLOC_INCREMENT)); /* didn't get the memory needed */ if (!tmp) { fprintf(stderr,"%s: out of memory\n", png_ident); return; } else { all_devices.devices = tmp; for (i=all_devices.nallocated; ifilename = malloc(length+1); if (! all_devices.devices[devnum]->filename) { fprintf(stderr,"%s: out of memory\n",png_ident); free(all_devices.devices[devnum]); all_devices.devices[devnum] = NULL; return; } make_device_active(devnum); ACTIVE_DEVICE->filename[length] = '\0'; strncpy(ACTIVE_DEVICE->filename,file,length); initialize_device_ctable(ACTIVE_DEVICE); ACTIVE_DEVICE->devnum = devnum; ACTIVE_DEVICE->npages = 0; if (mode & TRANS_ON) ACTIVE_DEVICE->trans = true; else ACTIVE_DEVICE->trans = false; *id = (float)devnum; *err = 1.0; return; } static void close_device( DeviceData *dev ) { int devnum = dev->devnum; if (dev->filename) free(dev->filename); free(all_devices.devices[devnum]); all_devices.devices[devnum] = NULL; if (all_devices.active == devnum) all_devices.active = -1; } #ifdef VMS void pndriv(int *opcode, float *rbuf, int *nbuf, struct dsc$descriptor_s *chrdsc, int *lchr, int *mode) { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void PNDRIV(int *opcode, float *rbuf, int *nbuf, char *chr, int *lchr, int *mode, int len) { #endif static int firsttime = 1; /* text used in warning messages */ if (*mode & TRANS_ON) png_ident = PNG_IDENT_TRANS; else png_ident = PNG_IDENT_BASIC; if (firsttime) { initialize_default_colortable(); initialize_all_devices(); firsttime = 0; } switch (*opcode) { /* Return device name */ case 1: { int i; char *name; if (*mode & TRANS_ON) name = DEVICE_NAME_TRANS; else name = DEVICE_NAME_BASIC; strncpy(chr,name,len); *lchr = strlen(name); for (i=*lchr; icindex ); break; /* fill dot */ case 13: fill_pixel(ACTIVE_DEVICE, (int)rbuf[0], (int)rbuf[1], ACTIVE_DEVICE->cindex); break; /* end picture */ case 14: end_plot(ACTIVE_DEVICE); break; /* set current color index */ case 15: ACTIVE_DEVICE->cindex = (ColorIndex)rbuf[0]; /* flush buffer */ case 16: break; /* erase alpha (text) screen */ case 18: break; /* set color representation */ case 21: set_color_rep( ACTIVE_DEVICE, (ColorIndex)rbuf[0], (ColorComponent)(rbuf[1]*255.0), (ColorComponent)(rbuf[2]*255.0), (ColorComponent)(rbuf[3]*255.0) ); break; /* escape function */ case 23: break; /* rectangle fill */ case 24: fill_rectangle( ACTIVE_DEVICE, (int)rbuf[0], (int)rbuf[1], (int)rbuf[2], (int)rbuf[3], ACTIVE_DEVICE->cindex ); break; /* fill line with data */ case 26: { int x = rbuf[0]; int y = rbuf[1]; int base = ACTIVE_DEVICE->w * y + x; int i; for (i = 0; i<(int)*nbuf-2; i++) ACTIVE_DEVICE->pixmap[base+i] = (ColorIndex)rbuf[i+2]; } break; /* query color representation */ case 29: { ColorComponent r, g, b; get_color_rep( ACTIVE_DEVICE, (ColorIndex)rbuf[0], &r, &g, &b ); rbuf[1] = r / 255.0; rbuf[2] = g / 255.0; rbuf[3] = b / 255.0; *nbuf = 4; }; break; default: fprintf(stderr,"%s: unhandled opcode = %d (please notify Pete Ratzlaff: pratzlaff@cfa.harvard.edu)\n",png_ident, *opcode); } } MPRESSION_TYPE_DEFAULT, PNG_FILTER_TYPE_DEFAULT ); png_set_PLTE(png_ptr, info_ptr, colors, NCOLORS); /* text to go in PNG file */ { png_text text[1]; text[0].key = "Software"; text[0].text = "PGPLOT Graphics Subroutine Library"; text[0].text_length = strlen(text[0].text); text[0].compression = PNG_TEXT_COMPRESSION_NONE; png_set_text(png_ptr, info_ptr, text, 1); }; /* set bKGD chunk */ /* not sure I know whapgplot/drivers/defines.h010064400040640000322000000025310626751202000157770ustar00tjpcitmbr00000400000017 /* defines.h: declarations file for the cgmdraw module. Written by G. Edward Johnson Date: April 1996 Copyright: cd software produced by NIST, an agency of the U.S. government, is by statute not subject to copyright in the United States. Recipients of this software assume all responsibilities associated with its operation, modification and maintenance. */ #ifndef CDDEF_H #define CDDEF_H 1 #define b0 01 #define b1 02 #define b2 04 #define b3 010 #define b4 020 #define b5 040 #define b6 0100 #define b7 0200 #define b8 0400 #define b9 01000 #define b10 02000 #define b11 04000 #define b12 010000 #define b13 020000 #define b14 040000 #define b15 0100000 /* Defines the default values for different attributes. In general, * these track the CGM specificaition, so changing them is not a good idea. * however, it is generally ok to set them to -1 (undefined) if you want. */ #define CDLTYPE 1 #define CDLWIDTH 0 #define CDLCOLOR 1 #define CDSHAPESTYLE 0 #define CDSHAPECOLOR 1 #define CDSHAPEHATCH 1 #define CDEDGETYPE 1 #define CDEDGECOLOR 1 #define CDEDGEWIDTH 1 #define CDEDGEVIS 0 #define CDTEXTFONT 1 #define CDTEXTCOLOR 1 #define CDTEXTHEIGHT -1 #define CDTEXTPATH 0 #define CDMTYPE 1 #define CDMSIZE 0 #define CDMCOLOR 1 #define CDLINESPEC 1 #define CDEDGESPEC 1 #define CDMARKERSPEC 1 #endif pgplot/src/pgqndt.f010064400040640000322000000012740631337676500150110ustar00tjpcitmbr00000400000017C*PGQNDT -- inquire number of available device types C%void cpgqndt(int *n); C+ SUBROUTINE PGQNDT(N) INTEGER N C C Return the number of available device types. This routine is C usually used in conjunction with PGQDT to get a list of the C available device types. C C Arguments: C N (output) : the number of available device types. C-- C 17-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- INTEGER NBUF, LCHR REAL RBUF(2) CHARACTER CHR C C Initialize PGPLOT if necessary. C CALL PGINIT C C Find number of device types. C CALL GREXEC(0, 0, RBUF, NBUF, CHR, LCHR) N = NINT(RBUF(1)) C END pgplot/src/pgqdt.f010064400040640000322000000045550631337722400146270ustar00tjpcitmbr00000400000017C*PGQDT -- inquire name of nth available device type C%void cpgqdt(int n, char *type, int *type_length, char *descr, \ C% int *descr_length, int *inter); C+ SUBROUTINE PGQDT(N, TYPE, TLEN, DESCR, DLEN, INTER) INTEGER N CHARACTER*(*) TYPE, DESCR INTEGER TLEN, DLEN, INTER C C Return the name of the Nth available device type as a character C string. The number of available types can be determined by calling C PGQNDT. If the value of N supplied is outside the range from 1 to C the number of available types, the routine returns DLEN=TLEN=0. C C Arguments: C N (input) : the number of the device type (1..maximum). C TYPE (output) : receives the character device-type code of the C Nth device type. The argument supplied should be C large enough for at least 8 characters. The first C character in the string is a '/' character. C TLEN (output) : receives the number of characters in TYPE, C excluding trailing blanks. C DESCR (output) : receives a description of the device type. The C argument supplied should be large enough for at C least 64 characters. C DLEN (output) : receives the number of characters in DESCR, C excluding trailing blanks. C INTER (output) : receives 1 if the device type is an interactive C one, 0 otherwise. C-- C 17-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- INTEGER NDEV, NBUF, LCHR, L1, L2 REAL RBUF CHARACTER*80 CHR C C Initialize PGPLOT if necessary. C CALL PGINIT C TYPE = 'error' TLEN = 0 DESCR = ' ' DLEN = 0 INTER = 1 CALL PGQNDT(NDEV) IF (N.GE.1 .AND. N.LE.NDEV) THEN NBUF = 0 CALL GREXEC(N, 1, RBUF, NBUF, CHR, LCHR) IF (LCHR.GT.0) THEN L1 = INDEX(CHR(1:LCHR), ' ') IF (L1.GT.1) THEN TYPE(1:1) = '/' IF (LEN(TYPE).GT.1) TYPE(2:) = CHR(1:L1-1) TLEN = MIN(L1,LEN(TYPE)) END IF L2 = INDEX(CHR(1:LCHR), '(') IF (L2.GT.0) DESCR = CHR(L2:LCHR) DLEN = MIN(LCHR-L2+1,LEN(DESCR)) CALL GREXEC(N, 4, RBUF, NBUF, CHR, LCHR) IF (CHR(1:1).EQ.'H') INTER = 0 END IF END IF C END haracter in the string is a '/' character. C TLEN (output) : receives the number of characters in TYPE, C excluding trailing pgplot/src/grdot1.f010064400040640000322000000036360631331157000146770ustar00tjpcitmbr00000400000017C*GRDOT1 -- draw dots C+ SUBROUTINE GRDOT1(POINTS, X, Y) INTEGER POINTS REAL X(POINTS), Y(POINTS) C C GRPCKG (internal routine): Draw a set of dots. C C Arguments: C C POINTS (input, integer): the number of coordinate pairs. C X, Y (input, real arrays, dimensioned POINTS or greater): the C X and Y world coordinates of the points. C-- C 14-Mar-1997 - new routine to optimize drawing many dots [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I, NBUF, LCHR REAL RBUF(2), XP, YP CHARACTER CHR EQUIVALENCE (XP, RBUF(1)), (YP, RBUF(2)) C C Begin picture if necessary. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C C Loop for points: driver support. C IF (GRWIDT(GRCIDE).LE.1) THEN NBUF = 2 LCHR = 0 DO 10 I=1,POINTS C -- Convert to device coordinates XP = X(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE) YP = Y(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) C -- Clip against viewport IF (XP .GE. GRXMIN(GRCIDE) .AND. : XP .LE. GRXMAX(GRCIDE) .AND. : YP .GE. GRYMIN(GRCIDE) .AND. : YP .LE. GRYMAX(GRCIDE)) THEN CALL GREXEC(GRGTYP,13,RBUF,NBUF,CHR,LCHR) END IF 10 CONTINUE C C Thick line emulation required. C ELSE DO 20 I=1,POINTS C -- Convert to device coordinates XP = X(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE) YP = Y(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) C -- Clip against viewport IF (XP .GE. GRXMIN(GRCIDE) .AND. : XP .LE. GRXMAX(GRCIDE) .AND. : YP .GE. GRYMIN(GRCIDE) .AND. : YP .LE. GRYMAX(GRCIDE)) THEN CALL GRLIN3(XP, YP, XP, YP) END IF 20 CONTINUE END IF C C New pen position. C GRXPRE(GRCIDE) = XP GRYPRE(GRCIDE) = YP C END pgplot/src/pgbeg.f010064400040640000322000000054240630543110100145520ustar00tjpcitmbr00000400000017C*PGBEG -- open a graphics device C%int cpgbeg(int unit, const char *file, int nxsub, int nysub); C+ INTEGER FUNCTION PGBEG (UNIT, FILE, NXSUB, NYSUB) INTEGER UNIT CHARACTER*(*) FILE INTEGER NXSUB, NYSUB C C Note: new programs should use PGOPEN rather than PGBEG. PGOPEN C is retained for compatibility with existing programs. Unlike PGOPEN, C PGBEG closes any graphics devices that are already open, so it C cannot be used to open devices to be used in parallel. C C PGBEG opens a graphical device or file and prepares it for C subsequent plotting. A device must be opened with PGBEG or PGOPEN C before any other calls to PGPLOT subroutines for the device. C C If any device is already open for PGPLOT output, it is closed before C the new device is opened. C C Returns: C PGBEG : a status return value. A value of 1 indicates C successful completion, any other value indicates C an error. In the event of error a message is C written on the standard error unit. C To test the return value, call C PGBEG as a function, eg IER=PGBEG(...); note C that PGBEG must be declared INTEGER in the C calling program. Some Fortran compilers allow C you to use CALL PGBEG(...) and discard the C return value, but this is not standard Fortran. C Arguments: C UNIT (input) : this argument is ignored by PGBEG (use zero). C FILE (input) : the "device specification" for the plot device. C (For explanation, see description of PGOPEN.) C NXSUB (input) : the number of subdivisions of the view surface in C X (>0 or <0). C NYSUB (input) : the number of subdivisions of the view surface in C Y (>0). C PGPLOT puts NXSUB x NYSUB graphs on each plot C page or screen; when the view surface is sub- C divided in this way, PGPAGE moves to the next C panel, not the next physical page. If C NXSUB > 0, PGPLOT uses the panels in row C order; if <0, PGPLOT uses them in column order. C-- C 21-Dec-1995 [TJP] - changed for multiple devices; call PGOPEN. C 27-Feb-1997 [TJP] - updated description. C----------------------------------------------------------------------- INTEGER IER INTEGER PGOPEN C C Initialize PGPLOT if necessary. C CALL PGINIT C C Close the plot-file if it is already open. C CALL PGEND C C Call PGOPEN to open the device. C IER = PGOPEN(FILE) IF (IER.GT.0) THEN CALL PGSUBP(NXSUB, NYSUB) PGBEG = 1 ELSE PGBEG = IER END IF C RETURN END pgplot/src/pgopen.f010064400040640000322000000206010630513370600147620ustar00tjpcitmbr00000400000017C*PGOPEN -- open a graphics device C%int cpgopen(const char *device); C+ INTEGER FUNCTION PGOPEN (DEVICE) CHARACTER*(*) DEVICE C C Open a graphics device for PGPLOT output. If the device is C opened successfully, it becomes the selected device to which C graphics output is directed until another device is selected C with PGSLCT or the device is closed with PGCLOS. C C The value returned by PGOPEN should be tested to ensure that C the device was opened successfully, e.g., C C ISTAT = PGOPEN('plot.ps/PS') C IF (ISTAT .LE. 0 ) STOP C C Note that PGOPEN must be declared INTEGER in the calling program. C C The DEVICE argument is a character constant or variable; its value C should be one of the following: C C (1) A complete device specification of the form 'device/type' or C 'file/type', where 'type' is one of the allowed PGPLOT device C types (installation-dependent) and 'device' or 'file' is the C name of a graphics device or disk file appropriate for this type. C The 'device' or 'file' may contain '/' characters; the final C '/' delimits the 'type'. If necessary to avoid ambiguity, C the 'device' part of the string may be enclosed in double C quotation marks. C (2) A device specification of the form '/type', where 'type' is one C of the allowed PGPLOT device types. PGPLOT supplies a default C file or device name appropriate for this device type. C (3) A device specification with '/type' omitted; in this case C the type is taken from the environment variable PGPLOT_TYPE, C if defined (e.g., setenv PGPLOT_TYPE PS). Because of possible C confusion with '/' in file-names, omitting the device type C in this way is not recommended. C (4) A blank string (' '); in this case, PGOPEN will use the value C of environment variable PGPLOT_DEV as the device specification, C or '/NULL' if the environment variable is undefined. C (5) A single question mark, with optional trailing spaces ('?'); in C this case, PGPLOT will prompt the user to supply the device C specification, with a prompt string of the form C 'Graphics device/type (? to see list, default XXX):' C where 'XXX' is the default (value of environment variable C PGPLOT_DEV). C (6) A non-blank string in which the first character is a question C mark (e.g., '?Device: '); in this case, PGPLOT will prompt the C user to supply the device specification, using the supplied C string as the prompt (without the leading question mark but C including any trailing spaces). C C In cases (5) and (6), the device specification is read from the C standard input. The user should respond to the prompt with a device C specification of the form (1), (2), or (3). If the user types a C question-mark in response to the prompt, a list of available device C types is displayed and the prompt is re-issued. If the user supplies C an invalid device specification, the prompt is re-issued. If the user C responds with an end-of-file character, e.g., ctrl-D in UNIX, program C execution is aborted; this avoids the possibility of an infinite C prompting loop. A programmer should avoid use of PGPLOT-prompting C if this behavior is not desirable. C C The device type is case-insensitive (e.g., '/ps' and '/PS' are C equivalent). The device or file name may be case-sensitive in some C operating systems. C C Examples of valid DEVICE arguments: C C (1) 'plot.ps/ps', 'dir/plot.ps/ps', '"dir/plot.ps"/ps', C 'user:[tjp.plots]plot.ps/PS' C (2) '/ps' (PGPLOT interprets this as 'pgplot.ps/ps') C (3) 'plot.ps' (if PGPLOT_TYPE is defined as 'ps', PGPLOT C interprets this as 'plot.ps/ps') C (4) ' ' (if PGPLOT_DEV is defined) C (5) '? ' C (6) '?Device specification for PGPLOT: ' C C [This routine was added to PGPLOT in Version 5.1.0. Older programs C use PGBEG instead.] C C Returns: C PGOPEN : returns either a positive value, the C identifier of the graphics device for use with C PGSLCT, or a 0 or negative value indicating an C error. In the event of error a message is C written on the standard error unit. C Arguments: C DEVICE (input) : the 'device specification' for the plot device C (see above). C-- C 22-Dec-1995 - new routine [TJP]. C 14-May-1996 - device '? ' should not give a blank prompt [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER DEFTYP,GRDTYP,GROPEN,L,LR,IC1, LPROMP INTEGER GRGCOM, IER, LDEFDE, UNIT, ISTAT REAL DUMMY,DUMMY2,XCSZ, XSZ, YSZ CHARACTER*128 DEFDEV, PROMPT CHARACTER*20 DEFSTR CHARACTER*256 REQ LOGICAL JUNK C C Initialize PGPLOT if necessary. C CALL PGINIT C C Get the default device/type (environment variable PGPLOT_DEV). C CALL GRGENV('DEV', DEFDEV, LDEFDE) IF (LDEFDE.EQ.0) THEN DEFDEV = '/NULL' LDEFDE = 5 END IF C C Open the plot file; default type is given by environment variable C PGPLOT_TYPE. C CALL GRGENV('TYPE', DEFSTR, L) IF (L.EQ.0) THEN DEFTYP = 0 ELSE CALL GRTOUP(DEFSTR, DEFSTR) DEFTYP = GRDTYP(DEFSTR(1:L)) END IF IF (DEVICE.EQ.' ') THEN C -- Blank device string: use default device and type. ISTAT = GROPEN(DEFTYP,UNIT,DEFDEV(1:LDEFDE),PGID) ELSE IF (DEVICE(1:1).EQ.'?') THEN IF (DEVICE.EQ.'?') THEN C -- Device string is a ingle question mark: prompt user C -- for device/type PROMPT = 'Graphics device/type (? to see list, default ' : //DEFDEV(1:LDEFDE)//'): ' LPROMP = LDEFDE + 48 ELSE C -- Device string starts with a question mark: use it C -- as a prompt PROMPT = DEVICE(2:) LPROMP = LEN(DEVICE)-1 END IF 10 IER = GRGCOM(REQ, PROMPT(1:LPROMP), LR) IF (IER.NE.1) THEN CALL GRWARN('Error reading device specification') PGOPEN = -1 RETURN END IF IF (LR.LT.1 .OR. REQ.EQ.' ') THEN REQ = DEFDEV(1:LDEFDE) ELSE IF (REQ(1:1).EQ.'?') THEN CALL PGLDEV GOTO 10 END IF ISTAT = GROPEN(DEFTYP,UNIT,REQ,PGID) IF (ISTAT.NE.1) GOTO 10 ELSE ISTAT = GROPEN(DEFTYP,UNIT,DEVICE,PGID) END IF C C Failed to open plot file? C IF (ISTAT.NE.1) THEN PGOPEN = - 1 RETURN END IF C C Success: determine device characteristics. C IF (PGID.LT.0 .OR. PGID.GT.PGMAXD) CALL 1 GRWARN('Something terribly wrong in PGOPEN') PGDEVS(PGID) = 1 PGADVS(PGID) = 0 PGPFIX(PGID) = .FALSE. CALL GRSIZE(PGID,XSZ,YSZ,DUMMY,DUMMY2, 1 PGXPIN(PGID),PGYPIN(PGID)) CALL GRCHSZ(PGID,XCSZ,DUMMY,PGXSP(PGID),PGYSP(PGID)) PGROWS(PGID)= .TRUE. PGNX(PGID) = 1 PGNY(PGID) = 1 PGXSZ(PGID) = XSZ PGYSZ(PGID) = YSZ PGNXC(PGID) = 1 PGNYC(PGID) = 1 CALL GRQTYP(DEFSTR,JUNK) C C Set the prompt state to ON, so that terminal devices pause between C pages; this can be changed with PGASK. C CALL PGASK(.TRUE.) C C If environment variable PGPLOT_BUFFER is defined (any value), C start buffering output. C PGBLEV(PGID) = 0 CALL GRGENV('BUFFER', DEFSTR, L) IF (L.GT.0) CALL PGBBUF C C Set background and foreground colors if requested. C CALL GRGENV('BACKGROUND', DEFSTR, L) IF (L.GT.0) CALL PGSCRN(0, DEFSTR(1:L), IER) CALL GRGENV('FOREGROUND', DEFSTR, L) IF (L.GT.0) CALL PGSCRN(1, DEFSTR(1:L), IER) C C Set default attributes. C CALL PGSCI(1) CALL PGSLS(1) CALL PGSLW(1) CALL PGSCH(1.0) CALL PGSCF(1) CALL PGSFS(1) CALL PGSAH(1, 45.0, 0.3) CALL PGSTBG(-1) CALL PGSHS(45.0, 1.0, 0.0) CALL PGSCLP(1) C C Set the default range of color indices available for images (16 to C device maximum, if device maximum >= 16; otherwise not possible). C Select linear transfer function. C CALL GRQCOL(IC1, PGMXCI(PGID)) PGMNCI(PGID) = 16 IF (PGMXCI(PGID).LT.16) PGMXCI(PGID) = 0 PGITF(PGID) = 0 C C Set the default window (unit square). C PGXBLC(PGID) = 0.0 PGXTRC(PGID) = 1.0 PGYBLC(PGID) = 0.0 PGYTRC(PGID) = 1.0 C C Set the default viewport. C CALL PGVSTD C PGOPEN = PGID RETURN END pgplot/src/pgend.f010064400040640000322000000013450630471165500145770ustar00tjpcitmbr00000400000017C*PGEND -- close all open graphics devices C%void cpgend(void); C+ SUBROUTINE PGEND C C Close and release any open graphics devices. All devices must be C closed by calling either PGCLOS (for each device) or PGEND before C the program terminates. If a device is not closed properly, some C or all of the graphical output may be lost. C C Arguments: none C-- C 22-Dec-1995 [TJP] - revised to call PGCLOS for each open device. C 25-Feb-1997 [TJP] - revised description. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER I C DO 10 I=1,PGMAXD IF (PGDEVS(I).EQ.1) THEN CALL PGSLCT(I) CALL PGCLOS END IF 10 CONTINUE END pgplot/src/pgqtxt.f010064400040640000322000000043330626675267700150510ustar00tjpcitmbr00000400000017C*PGQTXT -- find bounding box of text string C%void cpgqtxt(float x, float y, float angle, float fjust, \ C% const char *text, float *xbox, float *ybox); C+ SUBROUTINE PGQTXT (X, Y, ANGLE, FJUST, TEXT, XBOX, YBOX) REAL X, Y, ANGLE, FJUST CHARACTER*(*) TEXT REAL XBOX(4), YBOX(4) C C This routine returns a bounding box for a text string. Instead C of drawing the string as routine PGPTXT does, it returns in XBOX C and YBOX the coordinates of the corners of a rectangle parallel C to the string baseline that just encloses the string. The four C corners are in the order: lower left, upper left, upper right, C lower right (where left and right refer to the first and last C characters in the string). C C If the string is blank or contains no drawable characters, all C four elements of XBOX and YBOX are assigned the starting point C of the string, (X,Y). C C Arguments: C X, Y, ANGLE, FJUST, TEXT (input) : these arguments are the same as C the corrresponding arguments in PGPTXT. C XBOX, YBOX (output) : arrays of dimension 4; on output, they C contain the world coordinates of the bounding C box in (XBOX(1), YBOX(1)), ..., (XBOX(4), YBOX(4)). C-- C 12-Sep-1993 - new routine [TJP]. C 8-Nov-1994 - return something for blank string [TJP]. C 14-Jan-1997 - additional explanation [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO INTEGER I, L, GRTRIM REAL D, XP, YP, XPBOX(4), YPBOX(4), XOFFS, YOFFS C IF (PGNOTO('PGQTXT')) RETURN C L = GRTRIM(TEXT) IF (L.LE.0) THEN DO 15 I=1,4 XBOX(I) = X YBOX(I) = Y 15 CONTINUE ELSE D = 0.0 IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D) XOFFS = PGXORG(PGID) - D*FJUST*COS(ANGLE/57.29578) YOFFS = PGYORG(PGID) - D*FJUST*SIN(ANGLE/57.29578) XP = X*PGXSCL(PGID) + XOFFS YP = Y*PGYSCL(PGID) + YOFFS CALL GRQTXT(ANGLE, XP, YP, TEXT(1:L), XPBOX, YPBOX) DO 25 I=1,4 XBOX(I) = (XPBOX(I) - PGXORG(PGID))/PGXSCL(PGID) YBOX(I) = (YPBOX(I) - PGYORG(PGID))/PGYSCL(PGID) 25 CONTINUE END IF END REAL X, Y, ANGLE, FJUST CHARACTER*(*) TEXT REAL XBOX(4), YBOX(4) C C This routine returns a bounding box for a text string. Instead C of drawing the string as routine PGPTXT does, it returns in XBOX C and YBOX the coordinates of the corners of a rectangle parallel C to the pgplot/src/gropen.f010064400040640000322000000114660674243555600150120ustar00tjpcitmbr00000400000017C*GROPEN -- open device for graphics C+ INTEGER FUNCTION GROPEN (TYPE,DUMMY,FILE,IDENT) INTEGER TYPE, DUMMY, IDENT CHARACTER*(*) FILE C C GRPCKG: assign a device and prepare for plotting. GROPEN must be C called before all other calls to GRPCKG routines. C C Returns: C C GROPEN (output, integer): 1 => success, any other value C indicates a failure (usually the value returned will C be a VMS error code). In the event of an error, a C message will be sent to the standard error unit. C C Arguments: C C TYPE (input, integer): default device type (integer code). C DUMMY (input, integer): not used at present. C FILE (input, character): plot specifier, of form 'device/type'. C IDENT (output, integer): plot identifier to be used in later C calls to GRPCKG. C C 1-Jun-1984 - [TJP]. C 2-Jul-1984 - change to call GRSLCT [TJP]. C 13-Jul-1984 - add device initialization [TJP]. C 23-Jul-1984 - add /APPEND qualifier. C 19-Oct-1984 - add VV device [TJP]. C 26-Dec-1984 - obtain default file name from common [TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 12-Oct-1986 - fix bug causing GREXEC to erase screen [AFT]. C 3-Jun-1987 - remove declaration of exit handler [TJP]. C 15-Dec-1988 - standardize [TJP]. C 25-Jun-1989 - remove code that removes spaces from the device name C [TJP]. C 26-Nov-1990 - [TJP]. C 5-Jan-1993 - [TJP]. C 1-Sep-1994 - store device capabilities in common for later use [TJP]. C 17-Apr-1995 - zero-length string fix [TJP]. C 6-Jun-1995 - explicitly initialize GRSTAT [TJP]. C 29-Apr-1996 - moved initialization into GRINIT [TJP]. C 12-Jul-1999 - fix bug [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IER, FTYPE, NBUF, LCHR INTEGER GRPARS, GRTRIM REAL RBUF(6) LOGICAL APPEND CHARACTER*128 FFILE,CHR C C Initialize GRPCKG; read font file (if necessary). C CALL GRINIT C C Allocate an identifier. C IDENT = 1 10 IF (GRSTAT(IDENT).NE.0) THEN IDENT = IDENT+1 IF (IDENT.GT.GRIMAX) THEN CALL GRWARN('Too many active plots.') GROPEN = -1 IDENT = 0 RETURN END IF GOTO 10 END IF C C Validate the device specification. C IER = GRPARS(FILE,FFILE,FTYPE,APPEND) IF (IER.NE.1) THEN CHR = 'Invalid device specification: ' CHR(31:) = FILE CALL GRWARN(CHR) GROPEN = -1 RETURN END IF IF (FTYPE.EQ.0) FTYPE = TYPE IF (1.LE.FTYPE) THEN GRTYPE(IDENT) = FTYPE ELSE CHR = 'Device type omitted or invalid: ' CHR(33:) = FILE CALL GRWARN(CHR) GROPEN = -1 RETURN END IF C C Install the file name, or assign default. C IF (FFILE.EQ.' ') THEN CALL GREXEC(GRTYPE(IDENT), 5,RBUF,NBUF,FFILE,LCHR) END IF GRFILE(IDENT) = FFILE GRFNLN(IDENT) = MAX(1,GRTRIM(GRFILE(IDENT))) C C Open workstation. C RBUF(3)=0 IF (APPEND) RBUF(3)=1 NBUF=3 CALL GREXEC(GRGTYP, 9,RBUF,NBUF, GRFILE(IDENT),GRFNLN(IDENT)) GROPEN=RBUF(2) IF (GROPEN.NE.1) THEN IDENT = 0 RETURN END IF GRGTYP = GRTYPE(IDENT) GRUNIT(IDENT)=RBUF(1) GRPLTD(IDENT) = .FALSE. GRSTAT(IDENT) = 1 CALL GRSLCT(IDENT) C C Install the default plot parameters C C--- Inquire color-index range. CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR) GRMNCI(IDENT)=RBUF(5) GRMXCI(IDENT)=RBUF(6) C--- Inquire resolution. CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR) GRPXPI(IDENT)=RBUF(1) GRPYPI(IDENT)=RBUF(2) C--- Inquire default character size. CALL GREXEC(GRGTYP, 7,RBUF,NBUF,CHR,LCHR) GRCSCL(IDENT) = RBUF(1) GRCFAC(IDENT) = RBUF(1) C--- Inquire default plot size. CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR) GRXMXA(IDENT) = RBUF(2) GRYMXA(IDENT) = RBUF(4) GRXMIN(IDENT) = RBUF(1) GRXMAX(IDENT) = RBUF(2) GRYMIN(IDENT) = RBUF(3) GRYMAX(IDENT) = RBUF(4) C--- Inquire device capabilities. GRGCAP(IDENT) = 'NNNNNNNNNNN' CALL GREXEC(GRGTYP, 4,RBUF,NBUF,CHR,LCHR) IF (LCHR.GT.LEN(GRGCAP(IDENT))) LCHR = LEN(GRGCAP(IDENT)) GRGCAP(IDENT)(1:LCHR) = CHR(:LCHR) C--- Current pen position. GRXPRE(IDENT) = 0.0 GRYPRE(IDENT) = 0.0 C--- GRSETS has not been called. GRADJU(IDENT) = .FALSE. C---Default scaling. CALL GRTRN0(0.0, 0.0, 1.0, 1.0) C C Default attributes. C text font (normal) C color (white) C line-style (full) C line-width (minimum) C marker number (dot) C GRCFNT(IDENT) = 1 GRCCOL(IDENT) = 1 GRSTYL(IDENT) = 1 GRWIDT(IDENT) = 1 GRCMRK(IDENT) = 1 GRDASH(IDENT) = .FALSE. C GROPEN = 1 C END pgplot/src/pgaxis.f010064400040640000322000000137730631605442200150000ustar00tjpcitmbr00000400000017C*PGAXIS -- draw an axis C%void cpgaxis(const char *opt, float x1, float y1, float x2, float y2, \ C% float v1, float v2, float step, int nsub, float dmajl, \ C% float dmajr, float fmin, float disp, float orient); C+ SUBROUTINE PGAXIS (OPT, X1, Y1, X2, Y2, V1, V2, STEP, NSUB, : DMAJL, DMAJR, FMIN, DISP, ORIENT) CHARACTER*(*) OPT REAL X1, Y1, X2, Y2, V1, V2, STEP, DMAJL, DMAJR, FMIN, DISP REAL ORIENT INTEGER NSUB C C Draw a labelled graph axis from world-coordinate position (X1,Y1) to C (X2,Y2). C C Normally, this routine draws a standard LINEAR axis with equal C subdivisions. The quantity described by the axis runs from V1 to V2; C this may be, but need not be, the same as X or Y. C C If the 'L' option is specified, the routine draws a LOGARITHMIC axis. C In this case, the quantity described by the axis runs from 10**V1 to C 10**V2. A logarithmic axis always has major, labeled, tick marks C spaced by one or more decades. If the major tick marks are spaced C by one decade (as specified by the STEP argument), then minor C tick marks are placed at 2, 3, .., 9 times each power of 10; C otherwise minor tick marks are spaced by one decade. If the axis C spans less than two decades, numeric labels are placed at 1, 2, and C 5 times each power of ten. C C If the axis spans less than one decade, or if it spans many decades, C it is preferable to use a linear axis labeled with the logarithm of C the quantity of interest. C C Arguments: C OPT (input) : a string containing single-letter codes for C various options. The options currently C recognized are: C L : draw a logarithmic axis C N : write numeric labels C 1 : force decimal labelling, instead of automatic C choice (see PGNUMB). C 2 : force exponential labelling, instead of C automatic. C X1, Y1 (input) : world coordinates of one endpoint of the axis. C X2, Y2 (input) : world coordinates of the other endpoint of the axis. C V1 (input) : axis value at first endpoint. C V2 (input) : axis value at second endpoint. C STEP (input) : major tick marks are drawn at axis value 0.0 plus C or minus integer multiples of STEP. If STEP=0.0, C a value is chosen automatically. C NSUB (input) : minor tick marks are drawn to divide the major C divisions into NSUB equal subdivisions (ignored if C STEP=0.0). If NSUB <= 1, no minor tick marks are C drawn. NSUB is ignored for a logarithmic axis. C DMAJL (input) : length of major tick marks drawn to left of axis C (as seen looking from first endpoint to second), in C units of the character height. C DMAJR (input) : length of major tick marks drawn to right of axis, C in units of the character height. C FMIN (input) : length of minor tick marks, as fraction of major. C DISP (input) : displacement of baseline of tick labels to C right of axis, in units of the character height. C ORIENT (input) : orientation of label text, in degrees; angle between C baseline of text and direction of axis (0-360°). C-- C 25-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- REAL V, VMIN, VMAX, DVMAJ, DVMIN REAL PGRND INTEGER I, K, K1, K2, NSUBT, NV, NP, LLAB, CLIP, FORM LOGICAL OPTN, PGNOTO CHARACTER CH, LABEL*32 C C Check arguments. C IF (PGNOTO('PGAXIS')) RETURN IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN IF (V1.EQ.V2) RETURN C C Decode options. C FORM = 0 OPTN = .FALSE. DO 10 I=1,LEN(OPT) CH = OPT(I:I) CALL GRTOUP(CH, CH) IF (CH.EQ.'N') THEN C -- numeric labels requested OPTN = .TRUE. ELSE IF (CH.EQ.'L') THEN C -- logarithmic axis requested CALL PGAXLG(OPT, X1, Y1, X2, Y2, V1, V2, STEP, : DMAJL, DMAJR, FMIN, DISP, ORIENT) RETURN ELSE IF (CH.EQ.'1') THEN C -- decimal labels requested FORM = 1 ELSE IF (CH.EQ.'2') THEN C -- exponential labels requested FORM = 2 END IF 10 CONTINUE C C Choose major interval if defaulted. Requested interval = STEP, C with NSUB subdivisions. We will use interval = DVMAJ with NSUBT C subdivisions of size DVMIN. Note that DVMAJ is always positive. C IF (STEP.EQ.0.0) THEN DVMAJ = PGRND(0.20*ABS(V1-V2),NSUBT) ELSE DVMAJ = ABS(STEP) NSUBT = MAX(NSUB,1) END IF DVMIN = DVMAJ/NSUBT C C For labelling, we need to express DVMIN as an integer times a C power of 10, NV*(10**NP). C NP = INT(LOG10(ABS(DVMIN)))-4 NV = NINT(DVMIN/10.0**NP) DVMIN = REAL(NV)*(10.0**NP) C CALL PGBBUF CALL PGQCLP(CLIP) CALL PGSCLP(0) C C Draw the axis. C CALL PGMOVE(X1, Y1) CALL PGDRAW(X2, Y2) C C Draw the tick marks. Minor ticks are drawn at V = K*DVMIN, C major (labelled) ticks where K is a multiple of NSUBT. C VMIN = MIN(V1, V2) VMAX = MAX(V1, V2) K1 = INT(VMIN/DVMIN) IF (DVMIN*K1.LT.VMIN) K1 = K1+1 K2 = INT(VMAX/DVMIN) IF (DVMIN*K2.GT.VMAX) K2 = K2-1 DO 20 K=K1,K2 V = (K*DVMIN-V1)/(V2-V1) IF (MOD(K,NSUBT).EQ.0) THEN C -- major tick mark IF (OPTN) THEN CALL PGNUMB(K*NV, NP, FORM, LABEL, LLAB) ELSE LABEL = ' ' LLAB = 1 END IF CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL, DMAJR, : DISP, ORIENT, LABEL(:LLAB)) ELSE C -- minor tick mark CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN, : 0.0, ORIENT, ' ') END IF 20 CONTINUE C CALL PGSCLP(CLIP) CALL PGEBUF END qual pgplot/src/grsyxd.f010064400040640000322000000051670546005550300150230ustar00tjpcitmbr00000400000017C*GRSYXD -- obtain the polyline representation of a given symbol C+ SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED) INTEGER SYMBOL INTEGER XYGRID(300) LOGICAL UNUSED C C Return the digitization coordinates of a character. Each character is C defined on a grid with X and Y coordinates in the range (-49,49), C with the origin (0,0) at the center of the character. The coordinate C system is right-handed, with X positive to the right, and Y positive C upward. C C Arguments: C SYMBOL (input) : symbol number in range (1..3000). C XYGRID (output) : height range, width range, and pairs of (x,y) C coordinates returned. Height range = (XYGRID(1), C XYGRID(3)). Width range = (XYGRID(4),XYGRID(5)). C (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...). C UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol C number. A character of normal height and zero width C is returned. Receives .FALSE. if SYMBOL is a C valid symbol number. C C The height range consists of 3 values: (minimum Y, baseline Y, C maximum Y). The first is reached by descenders on lower-case g, p, C q, and y. The second is the bottom of upper-case letters. The third C is the top of upper-case letters. A coordinate pair (-64,0) requests C a pen raise, and a pair (-64,-64) terminates the coordinate list. It C is assumed that movement to the first coordinate position will be C done with the pen raised - no raise command is explicitly included to C do this. C-- C 7-Mar-1983. C 15-Dec-1988 - standardize. C----------------------------------------------------------------------- INTEGER*2 BUFFER(27000) INTEGER INDEX(3000), IX, IY, K, L, LOCBUF INTEGER NC1, NC2 COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER C C Extract digitization. C IF (SYMBOL.LT.NC1 .OR. SYMBOL.GT.NC2) GOTO 3000 L = SYMBOL - NC1 + 1 LOCBUF = INDEX(L) IF (LOCBUF .EQ. 0) GOTO 3000 XYGRID(1) = BUFFER(LOCBUF) LOCBUF = LOCBUF + 1 K = 2 IY = -1 C -- DO WHILE (IY.NE.-64) 100 IF (IY.NE.-64) THEN IX = BUFFER(LOCBUF)/128 IY = BUFFER(LOCBUF) - 128*IX - 64 XYGRID(K) = IX - 64 XYGRID(K+1) = IY K = K + 2 LOCBUF = LOCBUF + 1 GOTO 100 END IF C -- end DO WHILE UNUSED = .FALSE. RETURN C C Unimplemented character. C 3000 XYGRID(1) = -16 XYGRID(2) = -9 XYGRID(3) = +12 XYGRID(4) = 0 XYGRID(5) = 0 XYGRID(6) = -64 XYGRID(7) = -64 UNUSED = .TRUE. RETURN END pgplot/src/pgscrl.f010064400040640000322000000056070630507132100147670ustar00tjpcitmbr00000400000017C*PGSCRL -- scroll window C%void cpgscrl(float dx, float dy); C+ SUBROUTINE PGSCRL (DX, DY) REAL DX, DY C C This routine moves the window in world-coordinate space while C leaving the viewport unchanged. On devices that have the C capability, the pixels within the viewport are scrolled C horizontally, vertically or both in such a way that graphics C previously drawn in the window are shifted so that their world C coordinates are unchanged. C C If the old window coordinate range was (X1, X2, Y1, Y2), the new C coordinate range will be approximately (X1+DX, X2+DX, Y1+DY, Y2+DY). C The size and scale of the window are unchanged. C C Thee window can only be shifted by a whole number of pixels C (device coordinates). If DX and DY do not correspond to integral C numbers of pixels, the shift will be slightly different from that C requested. The new window-coordinate range, and hence the exact C amount of the shift, can be determined by calling PGQWIN after this C routine. C C Pixels that are moved out of the viewport by this operation are C lost completely; they cannot be recovered by scrolling back. C Pixels that are ``scrolled into'' the viewport are filled with C the background color (color index 0). C C If the absolute value of DX is bigger than the width of the window, C or the aboslute value of DY is bigger than the height of the window, C the effect will be the same as zeroing all the pixels in the C viewport. C C Not all devices have the capability to support this routine. C It is only available on some interactive devices that have discrete C pixels. To determine whether the current device has scroll capability, C call PGQINF. C C Arguments: C DX (input) : distance (in world coordinates) to shift the C window horizontally (positive shifts window to the C right and scrolls to the left). C DY (input) : distance (in world coordinates) to shift the C window vertically (positive shifts window up and C scrolls down). C-- C 25-Feb-97: new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL X1, X2, Y1, Y2, DDX, DDY INTEGER NDX, NDY C IF (PGNOTO('PGSCRL')) RETURN C C Shift must be a whole number of pixels. C NDX = NINT(DX*PGXSCL(PGID)) NDY = NINT(DY*PGYSCL(PGID)) C IF (NDX.NE.0 .OR. NDY.NE.0) THEN CALL PGBBUF DDX = NDX/PGXSCL(PGID) DDY = NDY/PGYSCL(PGID) C C -- Set new world-ccordinate window. C X1 = PGXBLC(PGID) X2 = PGXTRC(PGID) Y1 = PGYBLC(PGID) Y2 = PGYTRC(PGID) PGXBLC(PGID) = X1+DDX PGXTRC(PGID) = X2+DDX PGYBLC(PGID) = Y1+DDY PGYTRC(PGID) = Y2+DDY CALL PGVW C C -- Do hardware scroll. C CALL GRSCRL(NDX, NDY) CALL PGEBUF END IF END pgplot/src/pgtbox.f010064400040640000322000001311560622401015600147760ustar00tjpcitmbr00000400000017C*PGTBOX -- draw frame and write (DD) HH MM SS.S labelling C%void cpgtbox(const char *xopt, float xtick, int nxsub, \ C% const char *yopt, float ytick, int nysub); C+ SUBROUTINE PGTBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB) C REAL XTICK, YTICK INTEGER NXSUB, NYSUB CHARACTER XOPT*(*), YOPT*(*) C C Draw a box and optionally label one or both axes with (DD) HH MM SS C style numeric labels (useful for time or RA - DEC plots). If this C style of labelling is desired, then PGSWIN should have been called C previously with the extrema in SECONDS of time. C C In the seconds field, you can have at most 3 places after the decimal C point, so that 1 ms is the smallest time interval you can time label. C C Large numbers are coped with by fields of 6 characters long. Thus C you could have times with days or hours as big as 999999. However, C in practice, you might have trouble with labels overwriting themselves C with such large numbers unless you a) use a small time INTERVAL, C b) use a small character size or c) choose your own sparse ticks in C the call to PGTBOX. C C PGTBOX will attempt, when choosing its own ticks, not to overwrite C the labels, but this algorithm is not very bright and may fail. C C Note that small intervals but large absolute times such as C TMIN = 200000.0 s and TMAX=200000.1 s will cause the algorithm C to fail. This is inherent in PGPLOT's use of single precision C and cannot be avoided. In such cases, you should use relative C times if possible. C C PGTBOX's labelling philosophy is that the left-most or bottom tick of C the axis contains a full label. Thereafter, only changing fields are C labelled. Negative fields are given a '-' label, positive fields C have none. Axes that have the DD (or HH if the day field is not C used) field on each major tick carry the sign on each field. If the C axis crosses zero, the zero tick will carry a full label and sign. C C This labelling style can cause a little confusion with some special C cases, but as long as you know its philosophy, the truth can be divined. C Consider an axis with TMIN=20s, TMAX=-20s. The labels will look like C C +----------+----------+----------+----------+ C 0h0m20s 10s -0h0m0s 10s 20s C C Knowing that the left field always has a full label and that C positive fields are unsigned, informs that time is decreasing C from left to right, not vice versa. This can become very C unclear if you have used the 'F' option, but that is your problem ! C C Exceptions to this labelling philosophy are when the finest time C increment being displayed is hours (with option 'Y') or days. C Then all fields carry a label. For example, C C +----------+----------+----------+----------+ C -10h -8h -6h -4h -2h C C C PGTBOX can be used in place of PGBOX; it calls PGBOX and only invokes C time labelling if requested. Other options are passed intact to PGBOX. C C Inputs: C XOPT : X-options for PGTBOX. Same as for PGBOX plus C C 'Z' for (DD) HH MM SS.S time labelling C 'Y' means don't include the day field so that labels C are HH MM SS.S rather than DD HH MM SS.S The hours C will accumulate beyond 24 if necessary in this case. C 'X' label the HH field as modulo 24. Thus, a label C such as 25h 10m would come out as 1h 10m C 'H' means superscript numbers with d, h, m, & s symbols C 'D' means superscript numbers with o, ', & '' symbols C 'F' causes the first label (left- or bottom-most) to C be omitted. Useful for sub-panels that abut each other. C Care is needed because first label carries sign as well. C 'O' means omit leading zeros in numbers < 10 C E.g. 3h 3m 1.2s rather than 03h 03m 01.2s Useful C to help save space on X-axes. The day field does not C use this facility. C C YOPT : Y-options for PGTBOX. See above. C XTICK : X-axis major tick increment. 0.0 for default. C YTICK : Y-axis major tick increment. 0.0 for default. C If the 'Z' option is used then XTICK and/or YTICK must C be in seconds. C NXSUB : Number of intervals for minor ticks on X-axis. 0 for default C NYSUB : Number of intervals for minor ticks on Y-axis. 0 for default C C The regular XOPT and YOPT axis options for PGBOX are C C A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical C line X=0). C B : draw bottom (X) or left (Y) edge of frame. C C : draw top (X) or right (Y) edge of frame. C G : draw Grid of vertical (X) or horizontal (Y) lines. C I : Invert the tick marks; ie draw them outside the viewport C instead of inside. C L : label axis Logarithmically (see below). C N : write Numeric labels in the conventional location below the C viewport (X) or to the left of the viewport (Y). C P : extend ("Project") major tick marks outside the box (ignored if C option I is specified). C M : write numeric labels in the unconventional location above the C viewport (X) or to the right of the viewport (Y). C T : draw major Tick marks at the major coordinate interval. C S : draw minor tick marks (Subticks). C V : orient numeric labels Vertically. This is only applicable to Y. C The default is to write Y-labels parallel to the axis. C 1 : force decimal labelling, instead of automatic choice (see PGNUMB). C 2 : force exponential labelling, instead of automatic. C C The default is to write Y-labels parallel to the axis C C C ****************** EXCEPTIONS ******************* C C Note that C 1) PGBOX option 'L' (log labels) is ignored with option 'Z' C 2) The 'O' option will be ignored for the 'V' option as it C makes it impossible to align the labels nicely C 3) Option 'Y' is forced with option 'D' C C *************************************************************** C C C-- C 05-Sep-1988 - new routine (Neil Killeen) C 20-Apr-1991 - add support for new DD (day) field and implement C labelling on any axis (bottom,top,left,right) [nebk] C 10-Jun-1993 - add option 'O' for leading zeros, correctly deal with C user ticks, fully support 'V' and 'NM' options, modify C slightly meaning of 'F' option [nebk] C 16-Jan-1995 - add option 'X' [nebk] C 16-Aug-1996 - Bring axis labelling displacements more in line with C those of pgbox.f [nebk] C----------------------------------------------------------------------- REAL XTICKD, YTICKD, XMIN, XMAX, YMIN, YMAX INTEGER IPT, TSCALX, TSCALY, NXSUBD, NYSUBD CHARACTER XXOPT*15, YYOPT*15, SUPTYP*4 LOGICAL XTIME, YTIME, FIRST, DODAYX, DODAYY, DO2, DOPARA, MOD24 C------------------------------------------------------------------------ C C Copy inputs C XTICKD = XTICK YTICKD = YTICK NXSUBD = NXSUB NYSUBD = NYSUB C C Get window in world coordinates C CALL PGQWIN (XMIN, XMAX, YMIN, YMAX) C C X-axis first C CALL GRTOUP (XXOPT, XOPT) XTIME = .FALSE. IF (INDEX(XXOPT,'Z').NE.0) THEN C C Work out units for labelling and find the tick increments. C IF (ABS(XMAX-XMIN).LT.0.001) THEN CALL GRWARN ('PGTBOX: X-axis time interval too small '// * '(< 1 ms) for time labels') ELSE XTIME = .TRUE. DODAYX = .TRUE. IF (INDEX(XXOPT,'Y').NE.0 .OR. INDEX(XXOPT,'D').NE.0) * DODAYX = .FALSE. C DOPARA = .TRUE. CALL PGTBX1 ('X', DODAYX, DOPARA, XMIN, XMAX, XTICKD, * NXSUBD, TSCALX) END IF END IF C C Same again for Y-axis C CALL GRTOUP (YYOPT, YOPT) YTIME = .FALSE. IF (INDEX(YYOPT,'Z').NE.0) THEN IF (ABS(YMAX-YMIN).LT.0.001) THEN CALL GRWARN ('PGTBOX: Y-axis time interval too small '// * '(< 1ms) for time labels') ELSE YTIME = .TRUE. DODAYY = .TRUE. IF (INDEX(YYOPT,'Y').NE.0 .OR. INDEX(YYOPT,'D').NE.0) * DODAYY = .FALSE. C DOPARA = .TRUE. IF (INDEX(YYOPT,'V').NE.0) DOPARA = .FALSE. C CALL PGTBX1 ('Y', DODAYY, DOPARA, YMIN, YMAX, YTICKD, * NYSUBD, TSCALY) END IF END IF C C Parse options list. For call to PGBOX when doing time labelling, we C don't want L (log), N or M (write numeric labels). C IF (XTIME) THEN IPT = INDEX(XXOPT,'L') IF (IPT.NE.0) XXOPT(IPT:IPT) = ' ' IPT = INDEX(XXOPT,'N') IF (IPT.NE.0) XXOPT(IPT:IPT) = ' ' IPT = INDEX(XXOPT,'M') IF (IPT.NE.0) XXOPT(IPT:IPT) = ' ' END IF C IF (YTIME) THEN IPT = INDEX(YYOPT,'L') IF (IPT.NE.0) YYOPT(IPT:IPT) = ' ' IPT = INDEX(YYOPT,'N') IF (IPT.NE.0) YYOPT(IPT:IPT) = ' ' IPT = INDEX(YYOPT,'M') IF (IPT.NE.0) YYOPT(IPT:IPT) = ' ' END IF C C Draw box and ticks C CALL PGBOX (XXOPT, XTICKD, NXSUBD, YYOPT, YTICKD, NYSUBD) C C Add (DD) HH MM SS labels if desired. Go back to the original user C specified options list. C XXOPT = ' ' CALL GRTOUP (XXOPT, XOPT) IF (XTIME .AND. (INDEX(XXOPT,'N').NE.0 .OR. * INDEX(XXOPT,'M').NE.0)) THEN FIRST = .TRUE. IF (INDEX(XXOPT,'F').NE.0) FIRST = .FALSE. C SUPTYP = 'NONE' IF (INDEX(XXOPT,'D').NE.0) SUPTYP = ' DMS' IF (INDEX(XXOPT,'H').NE.0) SUPTYP = 'DHMS' C DO2 = .TRUE. IF (INDEX(XXOPT,'O').NE.0) DO2 = .FALSE. C DOPARA = .TRUE. C MOD24 = .FALSE. IF (INDEX(XXOPT,'X').NE.0) MOD24 = .TRUE. C IF (INDEX(XXOPT,'N').NE.0) * CALL PGTBX4 (DODAYX, SUPTYP, 'X', .TRUE., FIRST, * XMIN, XMAX, TSCALX, XTICKD, DO2, DOPARA, MOD24) C IF (INDEX(XXOPT,'M').NE.0) * CALL PGTBX4 (DODAYX, SUPTYP, 'X', .FALSE., FIRST, * XMIN, XMAX, TSCALX, XTICKD, DO2, DOPARA, MOD24) END IF C YYOPT = ' ' CALL GRTOUP (YYOPT, YOPT) IF (YTIME .AND. (INDEX(YYOPT,'N').NE.0 .OR. * INDEX(YYOPT,'M').NE.0)) THEN FIRST = .TRUE. IF (INDEX(YYOPT,'F').NE.0) FIRST = .FALSE. C SUPTYP = 'NONE' IF (INDEX(YYOPT,'D').NE.0) SUPTYP = ' DMS' IF (INDEX(YYOPT,'H').NE.0) SUPTYP = 'DHMS' C DOPARA = .TRUE. IF (INDEX(YYOPT,'V').NE.0) DOPARA = .FALSE. C DO2 = .TRUE. IF (DOPARA .AND. INDEX(YYOPT,'O').NE.0) DO2 = .FALSE. C MOD24 = .FALSE. IF (INDEX(YYOPT,'X').NE.0) MOD24 = .TRUE. C IF (INDEX(YYOPT,'N').NE.0) * CALL PGTBX4 (DODAYY, SUPTYP, 'Y', .TRUE., FIRST, * YMIN, YMAX, TSCALY, YTICKD, DO2, DOPARA, MOD24) C IF (INDEX(YYOPT,'M').NE.0) * CALL PGTBX4 (DODAYY, SUPTYP, 'Y', .FALSE., FIRST, * YMIN, YMAX, TSCALY, YTICKD, DO2, DOPARA, MOD24) C END IF C RETURN END C PGTBX1 -- support routine for PGTBOX C SUBROUTINE PGTBX1 (AXIS, DODAY, DOPARA, TMIN, TMAX, TICK, * NSUB, TSCALE) C REAL TMIN, TMAX, TICK INTEGER NSUB, TSCALE LOGICAL DODAY, DOPARA CHARACTER AXIS*1 C C Work out what the finest units the time labels will be in and C return the tick increments if the user does not set them. C C This is a support routine for PGTBOX and should not C be called by the user. C C Input: C AXIS : 'X' or 'Y' for use in determining if labels overwrite C TMIN : Start time in seconds C TMAX : End time in seconds C DOPARA : True if label to be parallel to axis, else perpendicular C Input/output: C DODAY : Write labels as DD HH MM SS.S else HH MM SS.S with C hours ranging above 24. Useful for declination labels C TICK : Major tick interval in seconds. If 0.0 on input, will C be set here. C NSUB : Number of minor ticks between major ticks. If 0 on input C will be set here. C Outputs: C TSCALE : Determines finest unit of labelling C (1 => ss, 60 => mm, 3600 => hh, 3600*24 => dd) C C 05-Sep-1988 - new routine (Neil Killeen) C 08-Apr-1991 - correctly work out HH MM SS when the time > 60 h [nebk] C 20-Apr-1991 - revise to add support for new DD (day) field and C do lots of work on tick algorithm [nebk] C 10-Jun-1993 - deal with user given ticks & rename from PGTIME [nebk/jm] C----------------------------------------------------------------------- INTEGER NLIST1, NLIST2, NLIST3, NLIST4, NTICMX PARAMETER (NLIST1 = 19, NLIST2 = 10, NLIST3 = 6, NLIST4 = 8, * NTICMX = 8) C REAL TICKS1(NLIST1), TICKS2(NLIST2), TICKS3(NLIST3), *TICKS4(NLIST4), TOCK, TOCK2, TINT, TINTS, TMINS, TMAXS INTEGER NSUBS1(NLIST1), NSUBS2(NLIST2), NSUBS3(NLIST3), *NSUBS4(NLIST4), NPL, NTICK, ITICK, STRLEN CHARACTER STR*15 C SAVE TICKS1, TICKS2, TICKS3, TICKS4 SAVE NSUBS1, NSUBS2, NSUBS3, NSUBS4 C DATA TICKS1 /0.001, 0.002, 0.005, * 0.01, 0.02, 0.05, * 0.1, 0.2, 0.5, * 1.0, 2.0, 3.0, 4.0, 5.0, * 6.0, 10.0, 15.0, 20.0, 30.0/ DATA NSUBS1 / 4, 4, 2, * 4, 4, 2, * 4, 4, 2, * 4, 4, 3, 4, 5, * 3, 2, 3, 2, 3/ C DATA TICKS2 /1.0, 2.0, 3.0, 4.0, 5.0, * 6.0, 10.0, 15.0, 20.0, 30.0/ DATA NSUBS2 / 4, 4, 3, 4, 5, * 3, 2, 3, 2, 3/ C DATA TICKS3 /1.0, 2.0, 3.0, 4.0, 6.0, 12.0/ DATA NSUBS3 / 4, 4, 3, 4, 3, 2/ C DATA TICKS4 /1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 8.0, 9.0/ DATA NSUBS4 / 4, 4, 3, 4, 5, 3, 4, 3 / C---------------------------------------------------------------------- C C Turn off DD (day) field if it has been unnecessarily asked for C IF ((ABS(TMIN).LT.24.0*3600.0) .AND. (ABS(TMAX).LT.24.0*3600.0)) * DODAY = .FALSE. C C If a tick size is provided, use it to determine TSCALE C TINT = ABS(TMAX - TMIN) TICK = ABS(TICK) IF (TICK.NE.0.0) THEN IF (TICK.GE.TINT) THEN CALL GRWARN ('PGTBX1: user given tick bigger than time ' * //'interval; will auto-tick') TICK = 0.0 ELSE IF (TICK.LT.0.001) THEN CALL GRWARN ('PGTBX1: user given tick too small (< 1 ms); ' * //'will auto-tick') TICK = 0.0 ELSE IF (MOD(TICK, 60.0) .NE. 0.0) THEN TSCALE = 1 ELSE IF (MOD(TICK, 3600.0).NE.0.0) THEN TSCALE = 60 ELSE IF (.NOT.DODAY) THEN TSCALE = 3600 ELSE IF (MOD(TICK,(24.0*3600.0)).NE.0.0) THEN TSCALE = 3600 ELSE TSCALE = 24 * 3600 ENDIF C C Make a simple default for the number of minor ticks and bug out C IF (NSUB.EQ.0) NSUB = 2 RETURN END IF END IF C C Work out label units depending on time interval if user C wants auto-ticking C IF (TINT.LE.5*60) THEN TSCALE = 1 ELSE IF (TINT.LE.5*3600) THEN TSCALE = 60 ELSE IF (.NOT.DODAY) THEN TSCALE = 3600 ELSE IF (TINT.LE.5*24*3600) THEN TSCALE = 3600 ELSE TSCALE = 3600*24 END IF END IF END IF C CCCCC C Divide interval into NTICK major ticks and NSUB minor intervals C The tick choosing algorithm is not very robust, so watch out C if you fiddle anything. CCCCC C TINTS = TINT / TSCALE IF (TSCALE.EQ.1) THEN C C Time in seconds. If the time interval is very small, may need to C label with up to 3 decimal places. Have less ticks to help prevent C label overwrite. STR is a dummy tick label to assess label C overwrite potential C IF (DOPARA) THEN IF (TINTS.LE.0.01) THEN NTICK = 4 STR = '60.423' STRLEN = 6 ELSE IF (TINTS.LE.0.1) THEN NTICK = 5 STR = '60.42' STRLEN = 5 ELSE IF (TINTS.LE.1.0) THEN NTICK = 6 STR = '60.4' STRLEN = 4 ELSE NTICK = 6 STR = '60s' STRLEN = 3 END IF ELSE NTICK = 6 STR = ' ' STRLEN = 1 END IF TOCK = TINTS / NTICK C C Select nearest tick to TOCK from list. C CALL PGTBX2 (TOCK, NLIST1, TICKS1, NSUBS1, TICK, NSUB, ITICK) C C Check label overwrite and/or too many ticks. C CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST1, TICKS1, * NSUBS1, ITICK, AXIS, DOPARA, STR(1:STRLEN), * TICK, NSUB) ELSE IF (TSCALE.EQ.60) THEN C C Time in minutes C NTICK = 6 TOCK = TINTS / NTICK C C Select nearest tick from list C CALL PGTBX2 (TOCK, NLIST2, TICKS2, NSUBS2, TICK, NSUB, ITICK) C C Check label overwrite and/or too many ticks. C IF (DOPARA) THEN STR = '42m' STRLEN = 3 ELSE STR = ' ' STRLEN = 1 END IF CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST2, TICKS2, * NSUBS2, ITICK, AXIS, DOPARA, STR(1:STRLEN), * TICK, NSUB) ELSE IF (TSCALE.EQ.3600 .AND. DODAY) THEN C C Time in hours with the day field C NTICK = 6 TOCK = TINTS / NTICK C C Select nearest tick from list C CALL PGTBX2 (TOCK, NLIST3, TICKS3, NSUBS3, TICK, NSUB, ITICK) C C Check label overwrite and/or too many ticks. C IF (DOPARA) THEN STR = '42h' STRLEN = 3 ELSE STR = ' ' STRLEN = 1 END IF CALL PGTBX3 (DODAY, 0, TSCALE, TINTS, NTICMX, NLIST3, TICKS3, * NSUBS3, ITICK, AXIS, DOPARA, STR(1:STRLEN), * TICK, NSUB) ELSE C C Time in hours with no day field or time in days. Have less C ticks for big numbers or the parallel labels will overwrite. IF (DOPARA) THEN TMINS = ABS(TMIN) / TSCALE TMAXS = ABS(TMAX) / TSCALE CALL PGNPL (-1, NINT(MAX(TINTS,TMINS,TMAXS)), NPL) IF (NPL.LE.3) THEN NTICK = 6 ELSE IF (NPL.EQ.4) THEN NTICK = 5 ELSE NTICK = 4 END IF STR = '345678912' STR(NPL+1:) = 'd' STRLEN = NPL + 1 ELSE STR = ' ' STRLEN = 1 NTICK = 6 END IF TOCK = TINTS / NTICK C C Select nearest tick from list; 1 choose nearest nice integer C scaled by the appropriate power of 10 C CALL PGNPL (-1, NINT(TOCK), NPL) TOCK2 = TOCK / 10**(NPL-1) C CALL PGTBX2 (TOCK2, NLIST4, TICKS4, NSUBS4, TICK, NSUB, ITICK) TICK = TICK * 10**(NPL-1) C C Check label overwrite and/or too many ticks. C CALL PGTBX3 (DODAY, NPL, TSCALE, TINTS, NTICMX, NLIST4, * TICKS4, NSUBS4, ITICK, AXIS, DOPARA, * STR(1:STRLEN), TICK, NSUB) END IF END IF C C Convert tick to seconds C TICK = TICK * TSCALE C RETURN END C PGTBX2 -- support routine for PGTBOX C SUBROUTINE PGTBX2 (TOCK, NTICKS, TICKS, NSUBS, TICK, NSUB, ITICK) C INTEGER NTICKS, NSUBS(NTICKS), NSUB, ITICK REAL TOCK, TICKS(NTICKS), TICK C C Find the nearest tick in a list to a given value. C C This is a support routine for PGTBOX and should not be called C by the user. C C Input: C TOCK : Try to find the nearest tick in the list to TOCK C NTICKS : Number of ticks in list C TICKS : List of ticks C NSUBS : List of number of minor ticks between ticks to go with TICKS C Output: C TICK : The selected tick C ITICK : The index of the selected tick from the list TICKS C Input/output C NSUB : Number of minor ticks between major ticks. If 0 on input C will be set here. C C 10-Jun-1993 - new routine [nebk] C----------------------------------------------------------------------- INTEGER I, NSUBD REAL DMIN, DIFF C---------------------------------------------------------------------- NSUBD = NSUB DMIN = 1.0E30 DO 100 I = 1, NTICKS DIFF = ABS(TOCK - TICKS(I)) IF (DIFF.LT.DMIN) THEN TICK = TICKS(I) IF (NSUBD.EQ.0) NSUB = NSUBS(I) ITICK = I C DMIN = DIFF END IF 100 CONTINUE C RETURN END C PGTBX3 -- support routine for PGTBOX C SUBROUTINE PGTBX3 (DODAY, NPL, TSCALE, TINTS, NTICMX, NTICKS, * TICKS, NSUBS, ITICK, AXIS, DOPARA, STR, * TICK, NSUB) C INTEGER TSCALE, NTICMX, NTICKS, ITICK, NSUB, NSUBS(NTICKS), NPL REAL TINTS, TICKS(NTICKS), TICK CHARACTER AXIS*1, STR*(*) LOGICAL DODAY, DOPARA C C Try to see if label overwrite is going to occur with this tick C selection, or if there are going to be more than a reasonable C number of ticks in the displayed time range. If so, choose, C if available, the next tick (bigger separation) up in the list. C If the overwrite requires that we would need to go up to the bext C TSCALE, give up. They will need to choose a smaller character size C C This is a support routine for PGTBOX and should not C be called by the user. C C Input: C DODAY : True if day field being used C NPL : Number of characters needed to format TICK on input C TSCALE : Dictates what the finest units of the labelling are. C 1 = sec, 60 = min, 3600 = hr, 24*3600 = days C TINTS : Absolute time interval in units of TSCALE C NTICMX : Max. reasonable number of ticks to allow in the time range C NTICKS : Number of ticks in list of ticks to choose from C TICKS : List of ticks from which the current tick was chosen C NSUBS : List of number of minor ticks/major tick to choose NSUB from C ITICK : Index of chosen tick in list TICKS C AXIS : 'X' or 'Y' axis C DOPARA : Labels parallel or perpendicualr to axis C STR : A typical formatted string used for checking overwrite C Input/output: C TICK : Current major tick interval in units of TSCALE. May be C made larger if possible if overwrite likely. C NSUB : Number of minor ticks between major ticks. C C 10-Jun-1993 - new routine [nebk] C----------------------------------------------------------------------- INTEGER NTICK REAL LENS, LENX, LENY C---------------------------------------------------------------------- CALL PGLEN (4, STR, LENX, LENY) LENS = LENX IF ( (DOPARA .AND. AXIS.EQ.'Y') .OR. * (.NOT.DOPARA .AND. AXIS.EQ.'X') ) LENS = LENY C IF (TSCALE.EQ.1 .OR. TSCALE.EQ.60 .OR. * (TSCALE.EQ.3600 .AND. DODAY)) THEN C C Time in seconds or minutes, or in hours with a day field C NTICK = INT(TINTS / TICK) IF ( (ITICK.LT.NTICKS) .AND. * ((DOPARA .AND. (LENS/TSCALE).GT.0.9*TICK) .OR. * (NTICK.GT.NTICMX)) ) THEN IF (TICKS(ITICK+1).LT.TINTS) THEN NSUB = NSUBS(ITICK+1) TICK = TICKS(ITICK+1) END IF END IF ELSE C C Time in hours and no day field or time in days C NTICK = INT(TINTS / TICK) IF ( (DOPARA .AND. (LENS/TSCALE).GT.0.9*TICK) .OR. * (NTICK.GT.NTICMX) ) THEN IF (ITICK.LT.NTICKS) THEN IF (TICKS(ITICK+1)*10**(NPL-1).LT.TINTS) THEN NSUB = NSUBS(ITICK+1) TICK = TICKS(ITICK+1) * 10**(NPL-1) END IF ELSE IF (TICKS(1)*10**NPL.LT.TINTS) THEN NSUB = NSUBS(1) TICK = TICKS(1) * 10**NPL END IF END IF END IF END IF C RETURN END C PGTBX4 -- support routine for PGTBOX C SUBROUTINE PGTBX4 (DODAY, SUPTYP, AXIS, CONVTL, FIRST, TMIN, * TMAX, TSCALE, TICK, DO2, DOPARA, MOD24) C REAL TMIN, TMAX, TICK INTEGER TSCALE CHARACTER AXIS*(*), SUPTYP*(*) LOGICAL FIRST, DODAY, CONVTL, DO2, DOPARA, MOD24 C C Label an axis in (DD) HH MM SS.S style. This is the main C workhorse of the PGTBOX routines. C C This is a support subroutine for PGTBOX and should not be C called by the user. C C Inputs: C DODAY : Write labels as DD HH MM SS.S else HH MM SS.S with C hours ranging above 24. Useful for declination labels C SUPTYP : If 'DHMS' then superscript the fields with d, h, m, & s C If ' DMS' then superscript the fields with o, ' & '' C Good for declination plots. You should obviously not C ask for the day field for this to do anything sensible. C If ' ' then no superscripting is done. C AXIS : 'X' for x-axis, 'Y' for y-axis C CONVTL : If .true., write the labels in the conventional axis C locations (bottom and left for 'X' and 'Y'). Otherwise C write them on the top and right axes ('X' and 'Y') C FIRST : If .false. then omit the first label. C TMIN : Start time (seconds) C TMAX : End time (seconds) C TSCALE : Determines finest units of axis C 1 => ss, 60 => mm, 3600 => hh, 3600*24 => dd C TICK : Major tick interval in seconds C DO2 : If .true., write labels less than 10 with a leading zero. C DOPARA : Y axis label parallel to axis, else perpendicular C MOD24 : HH field labelled as modulo 24 C C 05-Sep-1988 - new routine (Neil Killeen) C 20-Apr-1991 - add support for new DD (day) field [nebk] C 10-Jun-1993 - complete rewrite & rename from PGTLAB. Fixes user given C ticks bug too [nebk] C 15-Jan-1995 - Add argument MOD24 C----------------------------------------------------------------------- INTEGER MAXTIK LOGICAL T, F PARAMETER (MAXTIK = 1000, T = .TRUE., F = .FALSE.) C REAL SS(MAXTIK), TFRAC(MAXTIK) INTEGER DD(MAXTIK), HH(MAXTIK), MM(MAXTIK) CHARACTER*1 ASIGN(MAXTIK), ASIGNL C REAL TIME, XLEN, YLEN, COORD, FJUST, RVAL, SSL, DISP, *XLEN2, YLEN2 INTEGER IS, SD, NT, IZERO, IPOS, INEG, IT, I, J, K, SPREC, *JST(2), JEND(2), TLEN, LAST, IVAL(3), IVALO(3), IVALZ(3), *IVALF(3), IVALL(3), NPASS, INC, DDL, HHL, MML CHARACTER SIGNF*1, TEXT*80, AXLOC*2 LOGICAL WRIT(4) C----------------------------------------------------------------------- CALL PGBBUF C C Direction signs C SD = 1 IF (TMAX.LT.TMIN) SD = -1 IS = 1 IF (TMIN.LT.0.0) IS = -1 C C Find first tick. Return if none. C NT = TMIN / TICK IF (IS*SD.EQ.1 .AND. ABS(TMIN).GT.ABS(NT)*TICK) NT = NT + SD TIME = NT * TICK IF ( (SD.EQ. 1.AND.(TIME.LT.TMIN.OR.TIME.GT.TMAX)) .OR. * (SD.EQ.-1.AND.(TIME.GT.TMIN.OR.TIME.LT.TMAX)) ) RETURN C C Now step through time range in TICK increments and convert C times in seconds at each tick to +/- (DD) HH MM SS.S C IZERO = 0 IT = 1 100 IF ( (SD.EQ.1 .AND. TIME.GT.(TMAX+1.0E-5)) .OR. * (SD.EQ.-1 .AND. TIME.LT.(TMAX-1.0E-5)) ) GOTO 200 IF (IT.GT.MAXTIK) THEN CALL GRWARN ('PGTBX4: storage exhausted -- you have' * //'asked for far too many ticks') GOTO 200 END IF C C Convert to (DD) HH MM SS.S and find fraction of window that this C tick falls at C CALL PGTBX5 (DODAY, TIME, ASIGN(IT), DD(IT), HH(IT), * MM(IT), SS(IT)) TFRAC(IT) = (TIME - TMIN) / (TMAX - TMIN) C C Note zero tick C IF (NT.EQ.0) IZERO = IT C C Increment time C NT = NT + SD TIME = NT * TICK IT = IT + 1 C GOTO 100 200 CONTINUE IT = IT - 1 C C Work out the precision with which to write fractional seconds C labels into the SS.S field. All other fields have integer labels. C SPREC = 0 IF (TSCALE.EQ.1) THEN IF (TICK.LT.0.01) THEN SPREC = 3 ELSE IF (TICK.LT.0.1) THEN SPREC = 2 ELSE IF (TICK.LT.1.0) THEN SPREC = 1 END IF END IF C C Label special case of first tick. Prepare fields and label C CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(1), HH(1), MM(1), * SS(1), IVALF, RVAL, WRIT) SIGNF = 'H' IF (DODAY) SIGNF = 'D' CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(1), IVALF, RVAL, WRIT, * SPREC, DO2, TEXT, TLEN, LAST) C C Set label displacements from axes. This is messy for labels oriented C perpendicularly on the right hand axis as we need to know how long C the longest string we are going to write is before we write any C labels as they are right justified. C IF (AXIS.EQ.'X') THEN IF (CONVTL) THEN AXLOC = 'B' IF (SUPTYP.NE.'NONE') THEN DISP = 1.4 ELSE DISP = 1.2 END IF ELSE AXLOC = 'T' DISP = 0.7 END IF ELSE IF (AXIS.EQ.'Y') THEN IF (CONVTL) THEN AXLOC = 'LV' IF (DOPARA) AXLOC = 'L' DISP = 0.7 ELSE IF (DOPARA) THEN AXLOC = 'R' IF (SUPTYP.NE.'NONE') THEN DISP = 1.7 ELSE DISP = 1.9 END IF ELSE C C Work out number of characters in first label C AXLOC = 'RV' IF (ASIGN(1).NE.'-' .AND. TMIN*TMAX.LT.0.0) THEN CALL PGLEN (2, ' -'//TEXT(1:TLEN), XLEN, YLEN) ELSE CALL PGLEN (2, ' '//TEXT(1:TLEN), XLEN, YLEN) END IF CALL PGQCS (2, XLEN2, YLEN2) DISP = (XLEN/XLEN2) END IF END IF END IF C C Now write the label to the plot. The X-axis label for the first tick is C centred such that the last field of the label is centred on the tick C IF (FIRST) THEN CALL PGLEN (5, TEXT(LAST:TLEN), XLEN, YLEN) C IF (AXIS.EQ.'X') THEN COORD = TFRAC(1) + XLEN / 2.0 FJUST = 1.0 ELSE IF (AXIS.EQ.'Y') THEN IF (DOPARA) THEN COORD = TFRAC(1) + YLEN / 2.0 FJUST = 1.0 ELSE FJUST = 1.0 COORD = TFRAC(1) END IF END IF CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN)) END IF IF (IT.EQ.1) RETURN C C Designate which field out of DD or HH will carry the sign, depending C on whether you want the day field or not for the rest of the ticks C SIGNF = 'H' IF (DODAY) SIGNF = 'D' C C Set up labelling justifications for the rest of the labels C IF (AXIS.EQ.'X') THEN FJUST = 0.5 ELSE IF (AXIS.EQ.'Y') THEN IF (DOPARA) THEN FJUST = 0.5 ELSE FJUST = 1.0 END IF END IF C C Note zero crossings; IPOS is the first positive tick and C INEG is the first negative tick on either side of 0 C IPOS = 0 INEG = 0 C IF (IZERO.NE.0) THEN J = IZERO - 1 IF (J.GE.1) THEN IF (ASIGN(J).EQ.'-') THEN INEG = J ELSE IF (ASIGN(J).EQ.' ') THEN IPOS = J END IF END IF J = IZERO + 1 IF (J.LE.IT) THEN IF (ASIGN(J).EQ.'-') THEN INEG = J ELSE IF (ASIGN(J).EQ.' ') THEN IPOS = J END IF END IF END IF C C Now label special case of zero tick. It carries the sign change C when going from positive to negative time, left to right. C IF (IZERO.NE.0 .AND. IZERO.NE.1) THEN CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(IZERO), HH(IZERO), * MM(IZERO), SS(IZERO), IVALZ, RVAL, WRIT) C IF (ASIGN(IZERO-1).EQ.' ') ASIGN(IZERO) = '-' CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(IZERO), IVALZ, RVAL, WRIT, * SPREC, DO2, TEXT, TLEN, LAST) C COORD = TFRAC(IZERO) CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN)) END IF C C We may need an extra "virtual" tick if there is no zero crossing C and SD=-1 & IS=1 or SD=1 & IS=-1. It is used to work out which C fields to label on the right most tick which is labelled first. C IF (IZERO.EQ.0) THEN IF (SD*IS.EQ.-1) THEN IF ( (SD.EQ.-1 .AND. TIME.LE.0.0) .OR. * (SD.EQ. 1 .AND. TIME.GE.0.0) ) TIME = 0.0 CALL PGTBX5 (DODAY, TIME, ASIGNL, DDL, HHL, MML, SSL) CALL PGTBX6 (DODAY, MOD24, TSCALE, DDL, HHL, MML, SSL, * IVALL, RVAL, WRIT) END IF END IF C C We want to label in the direction(s) away from zero, so we may need C two passes. Determine the start and end ticks for each required pass. C JST(2) = 0 JEND(2) = 0 NPASS = 1 IF (IZERO.EQ.0) THEN IF (IS*SD.EQ.1) THEN JST(1) = 1 JEND(1) = IT ELSE JST(1) = IT JEND(1) = 1 END IF ELSE IF (INEG.EQ.0 .OR. IPOS.EQ.0) THEN JST(1) = IZERO JEND(1) = IT IF (IZERO.EQ.IT) JEND(1) = 1 ELSE NPASS = 2 JST(1) = IZERO JEND(1) = 1 JST(2) = IZERO JEND(2) = IT END IF END IF C C Now label the rest of the ticks. Always label away from 0 C DO 400 I = 1, NPASS C C Initialize previous tick values. Use virtual tick if labelling C left to right without a zero (one pass) C DO 250 K = 1, 3 IVALO(K) = IVALZ(K) IF (IZERO.EQ.0) THEN IVALO(K) = IVALL(K) IF (JST(I).EQ.1) IVALO(K) = IVALF(K) END IF 250 CONTINUE C INC = 1 IF (JEND(I).LT.JST(I)) INC = -1 DO 300 J = JST(I), JEND(I), INC C C First and zero tick already labelled C IF (J.NE.1 .AND. J.NE.IZERO) THEN C C Prepare fields C CALL PGTBX6 (DODAY, MOD24, TSCALE, DD(J), HH(J), MM(J), * SS(J), IVAL, RVAL, WRIT) C C Don't write unchanging fields C DO 275 K = 1, 3 IF (IVAL(K).EQ.IVALO(K)) WRIT(K) = F 275 CONTINUE C C Prepare label C CALL PGTBX7 (SUPTYP, SIGNF, ASIGN(J), IVAL, RVAL, WRIT, * SPREC, DO2, TEXT, TLEN, LAST) C C Write label C COORD = TFRAC(J) CALL PGMTXT (AXLOC, DISP, COORD, FJUST, TEXT(1:TLEN)) C C Update old values C DO 280 K = 1, 3 IVALO(K) = IVAL(K) 280 CONTINUE END IF 300 CONTINUE 400 CONTINUE CALL PGEBUF C RETURN END C PGTBX5 -- support routine for PGTBOX C SUBROUTINE PGTBX5 (DODAY, TSEC, ASIGN, D, H, M, S) C REAL S, TSEC INTEGER D, H, M LOGICAL DODAY CHARACTER*1 ASIGN C C Convert time in seconds to (DD) HH MM SS.S C C Input C DODAY : Use day field if true, else hours accumulates beyond 24 C TSEC : Time in seconds (signed) C Output C ASIGN : Sign, ' ' or '-' C D,H,M : DD, HH, MM (unsigned) C S : SS.S (unsigned) C C 10-Jun-1993 - new routine [nebk] C----------------------------------------------------------------------- INTEGER IT C---------------------------------------------------------------------- ASIGN = ' ' IF (TSEC.LT.0.0) ASIGN = '-' C S = MOD(ABS(TSEC),60.0) C IT = NINT(ABS(TSEC)-S) / 60 M = MOD(IT,60) C IT = (IT - M) / 60 IF (DODAY) THEN H = MOD(IT,24) D = (IT-H) / 24 ELSE H = IT D = 0 END IF C RETURN END C PGTBX6 -- support routine for PGTBOX C SUBROUTINE PGTBX6 (DODAY, MOD24, TSCALE, DD, HH, MM, SS, IVAL, * RVAL, WRIT) C INTEGER TSCALE, IVAL(3), DD, HH, MM REAL SS, RVAL LOGICAL WRIT(4), DODAY, MOD24 C C Find out which of the DD HH MM SS.S fields we want to write C into the label according to TSCALE and make a round off C error check. C C Input: C DODAY : Use day field if true else hours accrue beyond 24 C MOD24 : HH field labelled as modulo 24 C TSCALE : Dictates which fields appear in labels C DD : Day of time (will be 0 if DODAY=F and HH will compensate) C HH : Hour of time C MM : Minute of time C SS : Second of time C Output: C IVAL(3): DD HH MM to write into label C RVAL : SS.S to write into label C WRIT(4): T or F if DD,HH,MM,SS are to be written into the label C or not. IVAL and RVAL fields are set explicitly to C zero if the corresponding WRIT field is false. C This really is overkill. C C 10-Jun-1993 - New routine [nebk] C 16-Jan-1995 - Add argument MOD24 C----------------------------------------------------------------------- LOGICAL T, F PARAMETER (T = .TRUE., F = .FALSE.) INTEGER WM C----------------------------------------------------------------------- IVAL(1) = DD IVAL(2) = HH IVAL(3) = MM RVAL = SS C C SS should be 0.0; round off may get us 59.999 or the like but C not 60.001 (see PGTBX5) C IF (TSCALE.GT.1) THEN WM = NINT(SS/60.0) IVAL(3) = IVAL(3) + WM IF (IVAL(3).EQ.60) THEN IVAL(3) = 0 IVAL(2) = IVAL(2) + 1 IF (DODAY .AND. IVAL(2).EQ.24) THEN IVAL(2) = 0 IVAL(1) = IVAL(1) + 1 END IF END IF END IF C C Make HH field modulo 24 if desired C IF (MOD24) IVAL(2) = MOD(IVAL(2),24) C IF (TSCALE.EQ.1) THEN C C Label contains (DD) HH MM SS.S C WRIT(1) = DODAY WRIT(2) = T WRIT(3) = T WRIT(4) = T ELSE IF (TSCALE.EQ.60) THEN C C Label contains (DD) HH MM C WRIT(1) = DODAY WRIT(2) = T WRIT(3) = T C RVAL = 0.0 WRIT(4) = F ELSE IF (TSCALE.EQ.3600) THEN C C Label contains (DD) HH C WRIT(1) = DODAY WRIT(2) = T C IVAL(3) = 0 WRIT(3) = F C RVAL = 0.0 WRIT(4) = F ELSE IF (TSCALE.EQ.3600*24) THEN C C Label contains DD C WRIT(1) = T C IVAL(2) = 0 WRIT(2) = F C IVAL(3) = 0 WRIT(3) = F C RVAL = 0.0 WRIT(4) = F END IF C RETURN END SUBROUTINE PGTBX7 (SUPTYP, SIGNF, ASIGN, IVAL, RVAL, WRIT, * SPREC, DO2, TEXT, TLEN, LAST) C REAL RVAL INTEGER IVAL(3), TLEN, SPREC, LAST CHARACTER ASIGN*1, TEXT*(*), SIGNF*1, SUPTYP*4 LOGICAL WRIT(4), DO2 C C Write (DD) HH MM SS.S time labels into a string C C This is a support routine for PGTBOX and should not be C called by the user C C Inputs C SUPTYP : ' ', 'DHMS', or ' DMS' for no superscript labelling, C d,h,m,s or o,','' superscripting C SIGNF : Tells which field the sign is associated with. C One of 'D', 'H', 'M', or 'S' C ASIGN : ' ' or '-' for positive or negative times C IVAL(3): Day, hour, minutes of time C RVAL : Seconds of time C WRIT(4): If .true. then write DD, HH, MM, SS into label C SPREC : Number of places after the decimal to write seconds C string to. Must be in the range 0-3 C DO2 : If true, add a leading zero to numbers < 10 C Outputs C TEXT : Label C TLEN : Length of label C LAST : Is the location of the start character of the last C field written into TEXT C C 05-Sep-1989 -- New routine (Neil Killeen) C 20-Apr-1991 -- Complete rewrite; support for new DD (day) field and C superscripted labels [nebk] C 14-May-1991 -- Removed BSL as a parameter (Char(92)) and made it C a variable to appease Cray compiler [mjs/nebk] C 10-Jun-1993 -- Rename from PGTLB1, add code to label superscript C seconds above the '.' and add DO2 option [nebk/jm] C----------------------------------------------------------------------- INTEGER FLEN, FST, FMAX, TRLEN(3), SUPPNT, TMPNT, TLEN2, *IR1, IR2, IP CHARACTER FIELD*30, FRMAT2(3)*2, SUPER(4,3)*11, TMP*100, *BSL*1, FRMAT*30 C SAVE FRMAT2 SAVE TRLEN C DATA FRMAT2 /'I1', 'I2', 'I3'/ DATA TRLEN /5, 11, 5/ C----------------------------------------------------------------------- C C Initialize C BSL = CHAR(92) TLEN = 0 TEXT = ' ' C C Assign superscripting strings. Use CHAR(92) for backslash as the C latter must be escaped on SUNs thus requiring preprocessing. The C concatenator operator precludes the use of a data statement C SUPER(1,1) = BSL//'ud'//BSL//'d' SUPER(2,1) = BSL//'uh'//BSL//'d' SUPER(3,1) = BSL//'um'//BSL//'d' SUPER(4,1) = BSL//'us'//BSL//'d' C SUPER(1,2) = BSL//'u'//BSL//'(2199)'//BSL//'d' SUPER(2,2) = BSL//'u'//BSL//'(2729)'//BSL//'d' SUPER(3,2) = BSL//'u'//BSL//'(2727)'//BSL//'d' SUPER(4,2) = BSL//'u'//BSL//'(2728)'//BSL//'d' C SUPER(1,3) = BSL//'u'//' '//BSL//'d' SUPER(2,3) = BSL//'u'//' '//BSL//'d' SUPER(3,3) = BSL//'u'//' '//BSL//'d' SUPER(4,3) = BSL//'u'//' '//BSL//'d' C C Point at correct superscript strings C IF (SUPTYP.EQ.'DHMS') THEN SUPPNT = 1 ELSE IF (SUPTYP.EQ.' DMS') THEN SUPPNT = 2 ELSE SUPPNT = 3 END IF C CCCC C Days field CCCC C IF (WRIT(1)) THEN LAST = TLEN + 1 C C Write into temporary field C FIELD = ' ' CALL PGNPL (0, IVAL(1), FLEN) WRITE (FIELD, '(I6)') IVAL(1) FMAX = 6 FST = FMAX - FLEN + 1 C C Write output text string with desired superscripting C TMPNT = 2 IF (SIGNF.EQ.'D' .AND. ASIGN.NE.' ') TMPNT = 1 C TMP = ASIGN//FIELD(FST:FMAX)//SUPER(1,SUPPNT) TLEN2 = (2 - TMPNT) + FLEN + TRLEN(SUPPNT) C TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1) TLEN = TLEN + TLEN2 END IF C CCCC C Hours field CCCC C IF (WRIT(2)) THEN LAST = TLEN + 1 C C Write into temporary field C FIELD = ' ' CALL PGNPL (0, IVAL(2), FLEN) WRITE (FIELD, '(I6)') IVAL(2) FMAX = 6 FST = FMAX - FLEN + 1 C IF (DO2 .AND. FLEN.EQ.1) THEN FLEN = FLEN + 1 FST = FST - 1 FIELD(FST:FST) = '0' END IF C C Write output text string with desired superscripting C TMPNT = 2 IF (SIGNF.EQ.'H' .AND. ASIGN.NE.' ') TMPNT = 1 C TMP = ASIGN//FIELD(FST:FMAX)//SUPER(2,SUPPNT) TLEN2 = (2 - TMPNT) + FLEN + TRLEN(SUPPNT) C TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1) TLEN = TLEN + TLEN2 END IF C CCCC C Minutes field CCCC C IF (WRIT(3)) THEN LAST = TLEN + 1 C C Write into temporary field with desired superscripting C FIELD = ' ' WRITE (FIELD, '(I2, A)') IVAL(3), * SUPER(3,SUPPNT)(1:TRLEN(SUPPNT)) FMAX = 2 + TRLEN(SUPPNT) C FST = 1 IF (FIELD(FST:FST).EQ.' ') THEN IF (DO2) THEN FIELD(FST:FST) = '0' ELSE FST = FST + 1 END IF END IF FLEN = FMAX - FST + 1 C C Write output text string C TMPNT = 2 IF (SIGNF.EQ.'M' .AND. ASIGN.NE.' ') TMPNT = 1 C TMP = ASIGN//FIELD(FST:FMAX) TLEN2 = (2 - TMPNT) + FLEN C TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1) TLEN = TLEN + TLEN2 END IF C CCCC C Seconds field CCCC C IF (WRIT(4)) THEN LAST = TLEN + 1 C C Write into temporary field C FIELD = ' ' FST = 1 IF (SPREC.GE.1) THEN C C Fractional label. Upto 3 places after the decimal point allowed C Muck around to get the superscript on top of the decimal point C IR1 = INT(RVAL) IR2 = NINT((RVAL - IR1) * 10**SPREC) FRMAT = '(I2, A1, A, '//FRMAT2(SPREC)//')' WRITE (FIELD, FRMAT(1:15)) * IR1, '.', * BSL//'b'//SUPER(4,SUPPNT)(1:TRLEN(SUPPNT)), * IR2 IP = 5 + TRLEN(SUPPNT) + 1 IF (FIELD(IP:IP).EQ.' ') FIELD(IP:IP) = '0' IF (FIELD(IP+1:IP+1).EQ.' ') FIELD(IP+1:IP+1) = '0' FMAX = 1 + 2 + SPREC ELSE C C Integer label. C WRITE (FIELD, '(I2,A)') NINT(RVAL), * SUPER(4,SUPPNT)(1:TRLEN(SUPPNT)) FMAX = 0 END IF FMAX = FMAX + 2 + TRLEN(SUPPNT) C IF (FIELD(FST:FST).EQ.' ') THEN IF (DO2) THEN FIELD(FST:FST) = '0' ELSE FST = FST + 1 END IF END IF FLEN = FMAX - FST + 1 C C Write output text string C TMPNT = 2 IF (SIGNF.EQ.'S' .AND. ASIGN.NE.' ') TMPNT = 1 TMP = ASIGN//FIELD(FST:FMAX) TLEN2 = (3 - TMPNT) + FLEN C TEXT(TLEN+1:) = TMP(TMPNT:TMPNT+TLEN2-1) TLEN = TLEN + TLEN2 END IF C C A trailing blank will occur if no superscripting wanted C IF (TLEN.GE.5 .AND. TEXT(TLEN-4:TLEN).EQ.BSL//'u'//' '//BSL//'d') * TLEN = TLEN - 5 C RETURN END s beyond 24 C TSEC : Time in seconds (signed) C Output C ASIGN : Sign, ' ' or '-' C D,H,M : DD, HH, MM (unsigned) C S : SS.S (unsigned) C C 10-Jun-1993 - new routine [nebk] C----------------------------------------------------------------------- INTEGER IT C---------------------------------------------------------------------- ASIGN = ' ' IF (TSEC.LT.0.0) ASIpgplot/src/grpocl.f010064400040640000322000000064640622163632400147740ustar00tjpcitmbr00000400000017C*GRPOCL -- polygon clip C+ SUBROUTINE GRPOCL (N,PX,PY, EDGE, VAL, MAXOUT, NOUT, QX, QY) INTEGER N, NOUT, EDGE, MAXOUT REAL PX(*), PY(*), QX(*), QY(*) REAL VAL C C Clip a polygon against a rectangle: Sutherland-Hodgman algorithm. C this routine must be called four times to clip against each of the C edges of the rectangle in turn. C C Arguments: C C N (input, integer): the number of vertices of the polygon (at least C 3). C PX, PY (input, real arrays, dimension at least N): world coordinates C of the N vertices of the input polygon. C EDGE (input, integer): C 1: clip against left edge, X > XMIN=VAL C 2: clip against right edge, X < XMAX=VAL C 3: clip against bottom edge, Y > YMIN=VAL C 4: clip against top edge, Y < YMIN=VAL C VAL (input, real): coordinate value of current edge. C MAXOUT (input, integer): maximum number of vertices allowed in C output polygon (dimension of QX, QY). C NOUT (output, integer): the number of vertices in the clipped polygon. C QX, QY (output, real arrays, dimension at least MAXOUT): world C coordinates of the NOUT vertices of the output polygon. C-- C 19-Sep-1994 - [TJP]. C 27-Feb-1996 - fix bug: overflow if coordinates are large [TJP]. C 11-Jul-1996 - fix bug: left and bottom edges disappeared when precisely C on edge [Remko Scharroo] C----------------------------------------------------------------------- INTEGER I REAL FX, FY, SX, SY C NOUT = 0 DO 100 I=1,N IF (I.EQ.1) THEN C -- save first point FX = PX(I) FY = PY(I) ELSE IF ((EDGE.EQ.1 .OR.EDGE.EQ.2) .AND. : (SIGN(1.0,PX(I)-VAL).NE.SIGN(1.0,SX-VAL))) THEN C -- SP intersects this edge: output vertex at intersection NOUT = NOUT+1 IF (NOUT.LE.MAXOUT) THEN QX(NOUT) = VAL QY(NOUT) = SY + (PY(I)-SY)*((VAL-SX)/(PX(I)-SX)) END IF ELSE IF ((EDGE.EQ.3 .OR.EDGE.EQ.4) .AND. : (SIGN(1.0,PY(I)-VAL).NE.SIGN(1.0,SY-VAL))) THEN C -- SP intersects this edge: output vertex at intersection NOUT = NOUT+1 IF (NOUT.LE.MAXOUT) THEN QX(NOUT) = SX + (PX(I)-SX)*((VAL-SY)/(PY(I)-SY)) QY(NOUT) = VAL END IF END IF SX = PX(I) SY = PY(I) IF ((EDGE.EQ.1.AND.SX.GE.VAL) .OR. : (EDGE.EQ.2.AND.SX.LE.VAL) .OR. : (EDGE.EQ.3.AND.SY.GE.VAL) .OR. : (EDGE.EQ.4.AND.SY.LE.VAL)) THEN C -- output visible vertex S NOUT = NOUT + 1 IF (NOUT.LE.MAXOUT) THEN QX(NOUT) = SX QY(NOUT) = SY END IF END IF 100 CONTINUE C -- Does SF intersect edge? IF ((EDGE.EQ.1 .OR. EDGE.EQ.2) .AND. : (SIGN(1.0,SX-VAL).NE.SIGN(1.0,FX-VAL))) THEN NOUT = NOUT+1 IF (NOUT.LE.MAXOUT) THEN QX(NOUT) = VAL QY(NOUT) = SY + (FY-SY)*((VAL-SX)/(FX-SX)) END IF ELSE IF ((EDGE.EQ.3 .OR. EDGE.EQ.4) .AND. : (SIGN(1.0,SY-VAL).NE.SIGN(1.0,FY-VAL))) THEN NOUT = NOUT+1 IF (NOUT.LE.MAXOUT) THEN QY(NOUT) = VAL QX(NOUT) = SX + (FX-SX)*((VAL-SY)/(FY-SY)) END IF END IF C END pgplot/src/pgqinf.f010064400040640000322000000126540723566274700150060ustar00tjpcitmbr00000400000017C*PGQINF -- inquire PGPLOT general information C%void cpgqinf(const char *item, char *value, int *value_length); C+ SUBROUTINE PGQINF (ITEM, VALUE, LENGTH) CHARACTER*(*) ITEM, VALUE INTEGER LENGTH C C This routine can be used to obtain miscellaneous information about C the PGPLOT environment. Input is a character string defining the C information required, and output is a character string containing the C requested information. C C The following item codes are accepted (note that the strings must C match exactly, except for case, but only the first 8 characters are C significant). For items marked *, PGPLOT must be in the OPEN state C for the inquiry to succeed. If the inquiry is unsuccessful, either C because the item code is not recognized or because the information C is not available, a question mark ('?') is returned. C C 'VERSION' - version of PGPLOT software in use. C 'STATE' - status of PGPLOT ('OPEN' if a graphics device C is open for output, 'CLOSED' otherwise). C 'USER' - the username associated with the calling program. C 'NOW' - current date and time (e.g., '17-FEB-1986 10:04'). C 'DEVICE' * - current PGPLOT device or file. C 'FILE' * - current PGPLOT device or file. C 'TYPE' * - device-type of the current PGPLOT device. C 'DEV/TYPE' * - current PGPLOT device and type, in a form which C is acceptable as an argument for PGBEG. C 'HARDCOPY' * - is the current device a hardcopy device? ('YES' or C 'NO'). C 'TERMINAL' * - is the current device the user's interactive C terminal? ('YES' or 'NO'). C 'CURSOR' * - does the current device have a graphics cursor? C ('YES' or 'NO'). C 'SCROLL' * - does current device have rectangle-scroll C capability ('YES' or 'NO'); see PGSCRL. C C Arguments: C ITEM (input) : character string defining the information to C be returned; see above for a list of possible C values. C VALUE (output) : returns a character-string containing the C requested information, truncated to the length C of the supplied string or padded on the right with C spaces if necessary. C LENGTH (output): the number of characters returned in VALUE C (excluding trailing blanks). C-- C 18-Feb-1988 - [TJP]. C 30-Aug-1988 - remove pseudo logical use of IER. C 12-Mar-1992 - change comments for clarity. C 17-Apr-1995 - clean up some zero-length string problems [TJP]. C 7-Jul-1995 - get cursor information directly from driver [TJP]. C 24-Feb-1997 - add SCROLL request. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER IER, L1, GRTRIM LOGICAL INTER, SAME CHARACTER*8 TEST CHARACTER*64 DEV1 C C Initialize PGPLOT if necessary. C CALL PGINIT C CALL GRTOUP(TEST,ITEM) IF (TEST.EQ.'USER') THEN CALL GRUSER(VALUE, LENGTH) IER = 1 ELSE IF (TEST.EQ.'NOW') THEN CALL GRDATE(VALUE, LENGTH) IER = 1 ELSE IF (TEST.EQ.'VERSION') THEN VALUE = 'v5.2.2' LENGTH = 6 IER = 1 ELSE IF (TEST.EQ.'STATE') THEN IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN VALUE = 'CLOSED' LENGTH = 6 ELSE IF (PGDEVS(PGID).EQ.0) THEN VALUE = 'CLOSED' LENGTH = 6 ELSE VALUE = 'OPEN' LENGTH = 4 END IF IER = 1 ELSE IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN IER = 0 ELSE IF (PGDEVS(PGID).EQ.0) THEN IER = 0 ELSE IF (TEST.EQ.'DEV/TYPE') THEN CALL GRQDT(VALUE) LENGTH = GRTRIM(VALUE) IER = 0 IF (LENGTH.GT.0) IER = 1 ELSE IF (TEST.EQ.'DEVICE' .OR. TEST.EQ.'FILE') THEN CALL GRQDEV(VALUE, LENGTH) IER = 1 ELSE IF (TEST.EQ.'TERMINAL') THEN CALL GRQDEV(DEV1, L1) IF (L1.GE.1) THEN CALL GRTTER(DEV1(1:L1), SAME) ELSE SAME = .FALSE. END IF IF (SAME) THEN VALUE = 'YES' LENGTH = 3 ELSE VALUE = 'NO' LENGTH = 2 END IF IER = 1 ELSE IF (TEST.EQ.'TYPE') THEN CALL GRQTYP(VALUE,INTER) LENGTH = GRTRIM(VALUE) IER = 0 IF (LENGTH.GT.0) IER = 1 ELSE IF (TEST.EQ.'HARDCOPY') THEN CALL GRQTYP(VALUE,INTER) IF (INTER) THEN VALUE = 'NO' LENGTH = 2 ELSE VALUE = 'YES' LENGTH = 3 END IF IER = 1 ELSE IF (TEST.EQ.'CURSOR') THEN CALL GRQCAP(DEV1) IF (DEV1(2:2).EQ.'N') THEN VALUE = 'NO' LENGTH = 2 ELSE VALUE = 'YES' LENGTH = 3 END IF IER = 1 ELSE IF (TEST.EQ.'SCROLL') THEN CALL GRQCAP(DEV1) IF (DEV1(11:11).NE.'S') THEN VALUE = 'NO' LENGTH = 2 ELSE VALUE = 'YES' LENGTH = 3 END IF IER = 1 ELSE IER = 0 END IF IF (IER.NE.1) THEN VALUE = '?' LENGTH = 1 ELSE IF (LENGTH.LT.1) THEN LENGTH = 1 VALUE = ' ' END IF END pgplot/src/pgshs.f010064400040640000322000000035040610774115000146170ustar00tjpcitmbr00000400000017C*PGSHS -- set hatching style C%void cpgshs(float angle, float sepn, float phase); C+ SUBROUTINE PGSHS (ANGLE, SEPN, PHASE) REAL ANGLE, SEPN, PHASE C C Set the style to be used for hatching (fill area with fill-style 3). C The default style is ANGLE=45.0, SEPN=1.0, PHASE=0.0. C C Arguments: C ANGLE (input) : the angle the hatch lines make with the C horizontal, in degrees, increasing C counterclockwise (this is an angle on the C view surface, not in world-coordinate space). C SEPN (input) : the spacing of the hatch lines. The unit spacing C is 1 percent of the smaller of the height or C width of the view surface. This should not be C zero. C PHASE (input) : a real number between 0 and 1; the hatch lines C are displaced by this fraction of SEPN from a C fixed reference. Adjacent regions hatched with the C same PHASE have contiguous hatch lines. To hatch C a region with alternating lines of two colors, C fill the area twice, with PHASE=0.0 for one color C and PHASE=0.5 for the other color. C-- C 26-Feb-1995 - new routine [TJP]. C 12-Feb-1996 - check for zero spacing [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSHS')) RETURN PGHSA(PGID) = ANGLE IF (SEPN.EQ.0.0) THEN CALL GRWARN('PGSHS: zero hatch line spacing requested') PGHSS(PGID) = 1.0 ELSE PGHSS(PGID) = SEPN END IF IF (PHASE.LT.0.0 .OR. PHASE.GT.1.0) THEN CALL GRWARN('PGSHS: hatching phase must be in (0.0,1.0)') END IF PGHSP(PGID) = PHASE C END pgplot/src/grpckg1.inc010064400040640000322000000075070633173331100153630ustar00tjpcitmbr00000400000017C----------------------------------------------------------------------- C Include file for GRPCKG C Modifications: C 29-Jan-1985 - add HP2648 (KS/TJP). C 16-Sep-1985 - remove tabs (TJP). C 30-Dec-1985 - add PS, VPS (TJP). C 27-May-1987 - remove ARGS, NULL, PS, VPS, QMS, VQMS, HIDMP, C HP7221, GRINL (TJP). C 6-Jun-1987 - remove PRTX, TRILOG, VERS, VV (TJP). C 11-Jun-1987 - remove remaining built-in devices (TJP). C 5-Jul-1987 - replace GRINIT, GRPLTD by GRSTAT. C 16-Aug-1987 - remove obsolete variables. C 9-Sep-1989 - add SAVE statement. C 26-Nov-1990 - remove GRCTYP. C 5-Jan-1993 - add GRADJU. C 1-Sep-1994 - add GRGCAP. C 21-Dec-1995 - increase GRIMAX to 8. C 30-Apr-1997 - remove GRC{XY}SP C----------------------------------------------------------------------- C C Parameters: C GRIMAX : maximum number of concurrent devices C GRFNMX : maximum length of file names C GRCXSZ : default width of chars (pixels) C GRCYSZ : default height of chars (pixels) C INTEGER GRIMAX, GRFNMX REAL GRCXSZ, GRCYSZ PARAMETER (GRIMAX = 8) PARAMETER (GRFNMX = 90) PARAMETER (GRCXSZ = 7.0, GRCYSZ = 9.0) C C Common blocks: C GRCIDE : identifier of current plot C GRGTYP : device type of current plot C The following are qualified by a plot id: C GRSTAT : 0 => workstation closed C 1 => workstation open C 2 => picture open C GRPLTD : C GRDASH : software dashing in effect? C GRUNIT : unit associated with id C GRFNLN : length of filename C GRTYPE : device type C GRXMXA : x size of plotting surface C GRYMXA : y size of plotting surface C GRXMIN : blc of plotting window C GRYMIN : ditto C GRXMAX : trc of plotting window C GRYMAX : ditto C GRSTYL : line style (integer code) C GRWIDT : line width (integer code) C GRCCOL : current color index (integer code) C GRMNCI : minimum color index on this device C GRMXCI : maximum color index on this device C GRCMRK : marker number C GRXPRE : previous (current) pen position (x) C GRYPRE : ditto (y) C GRXORG : transformation variables (GRTRAN) C GRYORG : ditto C GRXSCL : ditto C GRYSCL : ditto C GRCSCL : character scaling factor C GRCFAC : C GRCFNT : character font C GRFILE : file name (character) C GRGCAP : device capabilities (character) C GRPXPI : pixels per inch in x C GRPYPI : pixels per inch in y C GRADJU : TRUE if GRSETS (PGPAP) has been called C INTEGER GRCIDE, GRGTYP LOGICAL GRPLTD(GRIMAX), GRDASH(GRIMAX), GRADJU(GRIMAX) INTEGER GRSTAT(GRIMAX) INTEGER GRUNIT(GRIMAX), GRFNLN(GRIMAX), GRTYPE(GRIMAX), 1 GRXMXA(GRIMAX), GRYMXA(GRIMAX), 2 GRSTYL(GRIMAX), GRWIDT(GRIMAX), GRCCOL(GRIMAX), 3 GRCMRK(GRIMAX), GRIPAT(GRIMAX), GRCFNT(GRIMAX), 4 GRMNCI(GRIMAX), GRMXCI(GRIMAX) REAL GRXMIN(GRIMAX), GRYMIN(GRIMAX), 1 GRXMAX(GRIMAX), GRYMAX(GRIMAX) REAL GRXPRE(GRIMAX), GRYPRE(GRIMAX), GRXORG(GRIMAX), 1 GRYORG(GRIMAX), GRXSCL(GRIMAX), GRYSCL(GRIMAX), 2 GRCSCL(GRIMAX), GRCFAC(GRIMAX), GRPOFF(GRIMAX), 3 GRPATN(GRIMAX,8),GRPXPI(GRIMAX),GRPYPI(GRIMAX) COMMON /GRCM00/ GRCIDE, GRGTYP, GRSTAT, GRPLTD, GRUNIT, 1 GRFNLN, GRTYPE, GRXMXA, GRYMXA, GRXMIN, GRYMIN, 2 GRXMAX, GRYMAX, GRWIDT, GRCCOL, GRSTYL, 3 GRXPRE, GRYPRE, GRXORG, GRYORG, GRXSCL, GRYSCL, 4 GRCSCL, GRCFAC, GRDASH, GRPATN, GRPOFF, 5 GRIPAT, GRCFNT, GRCMRK, GRPXPI, GRPYPI, GRADJU, 6 GRMNCI, GRMXCI C CHARACTER*(GRFNMX) GRFILE(GRIMAX) CHARACTER*11 GRGCAP(GRIMAX) COMMON /GRCM01/ GRFILE, GRGCAP SAVE /GRCM00/, /GRCM01/ C----------------------------------------------------------------------- ) C GRCCOL : current color index (integer code) C GRMNCI : minimum color index on this device C GRMXCI : maximum color index on this device C GRCMRK : marker number C GRXPRE :pgplot/src/pglen.f010064400040640000322000000033350613406371600146070ustar00tjpcitmbr00000400000017C*PGLEN -- find length of a string in a variety of units C%void cpglen(int units, const char *string, float *xl, float *yl); C+ SUBROUTINE PGLEN (UNITS, STRING, XL, YL) REAL XL, YL INTEGER UNITS CHARACTER*(*) STRING C C Work out length of a string in x and y directions C C Input C UNITS : 0 => answer in normalized device coordinates C 1 => answer in inches C 2 => answer in mm C 3 => answer in absolute device coordinates (dots) C 4 => answer in world coordinates C 5 => answer as a fraction of the current viewport size C C STRING : String of interest C Output C XL : Length of string in x direction C YL : Length of string in y direction C C-- C 15-Sep-1989 - new routine (Neil Killeen) C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL D C IF (PGNOTO('PGLEN')) RETURN C C Work out length of a string in absolute device coordinates (dots) C and then convert C CALL GRLEN (STRING, D) C IF (UNITS.EQ.0) THEN XL = D / PGXSZ(PGID) YL = D / PGYSZ(PGID) ELSE IF (UNITS.EQ.1) THEN XL = D / PGXPIN(PGID) YL = D / PGYPIN(PGID) ELSE IF (UNITS.EQ.2) THEN XL = 25.4 * D / PGXPIN(PGID) YL = 25.4 * D / PGYPIN(PGID) ELSE IF (UNITS.EQ.3) THEN XL = D YL = D ELSE IF (UNITS.EQ.4) THEN XL = D / ABS(PGXSCL(PGID)) YL = D / ABS(PGYSCL(PGID)) ELSE IF (UNITS.EQ.5) THEN XL = D / PGXLEN(PGID) YL = D / PGYLEN(PGID) ELSE CALL GRWARN('Illegal value for UNITS in routine PGLEN') END IF C RETURN END pgplot/src/pgncur.f010064400040640000322000000106660606640060100147750ustar00tjpcitmbr00000400000017C*PGNCUR -- mark a set of points using the cursor C%void cpgncur(int maxpt, int *npt, float *x, float *y, int symbol); C+ SUBROUTINE PGNCUR (MAXPT, NPT, X, Y, SYMBOL) INTEGER MAXPT, NPT REAL X(*), Y(*) INTEGER SYMBOL C C Interactive routine for user to enter data points by use of C the cursor. Routine allows user to Add and Delete points. The C points are returned in order of increasing x-coordinate, not in the C order they were entered. C C Arguments: C MAXPT (input) : maximum number of points that may be accepted. C NPT (in/out) : number of points entered; should be zero on C first call. C X (in/out) : array of x-coordinates. C Y (in/out) : array of y-coordinates. C SYMBOL (input) : code number of symbol to use for marking C entered points (see PGPT). C C Note (1): The dimension of arrays X and Y must be greater than or C equal to MAXPT. C C Note (2): On return from the program, cursor points are returned in C increasing order of X. Routine may be (re-)called with points C already defined in X,Y (number in NPT), and they will be plotted C first, before editing. C C Note (3): User commands: the user types single-character commands C after positioning the cursor: the following are accepted: C A (Add) - add point at current cursor location. C D (Delete) - delete nearest point to cursor. C X (eXit) - leave subroutine. C-- C 27-Nov-1983 C 9-Jul-1983 - modified to use GRSCI instead of GRSETLI [TJP]. C 13-Dec-1990 - changed warnings to messages [TJP]. C 2-Aug-1995 - [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*1 LETTER LOGICAL PGNOTO INTEGER PGCURS, I, J, SAVCOL REAL DELTA, XP, YP, XPHYS, YPHYS REAL XMIN, XIP, YIP REAL XBLC, XTRC, YBLC, YTRC C C Check that PGPLOT is in the correct state. C IF (PGNOTO('PGNCUR')) RETURN C C Save current color. C CALL GRQCI(SAVCOL) C C Put current points on screen. C IF (NPT.NE.0) CALL PGPT(NPT,X,Y,SYMBOL) C C Start with the cursor in the middle of the viewport. C CALL PGQWIN(XBLC, XTRC, YBLC, YTRC) XP = 0.5*(XBLC+XTRC) YP = 0.5*(YBLC+YTRC) C C Loop over cursor inputs. C 100 IF (PGCURS(XP,YP,LETTER).NE.1) RETURN IF (LETTER.EQ.CHAR(0)) RETURN CALL GRTOUP(LETTER,LETTER) C C A (ADD) command: C IF (LETTER .EQ. 'A') THEN IF (NPT.GE.MAXPT) THEN CALL GRMSG('ADD ignored (too many points).') GOTO 100 END IF C ! Find what current points new point is between. DO 120 J=1,NPT IF (XP.LT.X(J)) GOTO 122 120 CONTINUE J = NPT + 1 C ! New point is beyond last current 122 CONTINUE C ! J is vector location where new point should be included. DO 140 I=NPT,J,-1 X(I+1) = X(I) Y(I+1) = Y(I) 140 CONTINUE NPT = NPT + 1 C ! Add new point to point array. X(J) = XP Y(J) = YP CALL PGPT(1,X(J),Y(J),SYMBOL) CALL GRTERM C C D (DELETE) command: C ELSE IF (LETTER.EQ.'D') THEN IF (NPT.LE.0) THEN CALL GRMSG('DELETE ignored (there are no points left).') GOTO 100 END IF XMIN = 1.E+08 C ! Look for point closest in radius. C ! Convert cursor points to physical. XPHYS = PGXORG(PGID) + XP*PGXSCL(PGID) YPHYS = PGYORG(PGID) + YP*PGYSCL(PGID) DO 220 I=1,NPT C ! Convert array points to physical. XIP = PGXORG(PGID) + X(I)*PGXSCL(PGID) YIP = PGYORG(PGID) + Y(I)*PGYSCL(PGID) DELTA = SQRT( (XIP-XPHYS)**2 + (YIP-YPHYS)**2 ) IF (DELTA.LT.XMIN) THEN XMIN = DELTA J = I END IF 220 CONTINUE C ! Remove point from screen by writing in background color. CALL GRSCI(0) CALL PGPT(1,X(J),Y(J),SYMBOL) CALL GRSCI(SAVCOL) CALL GRTERM C ! Remove point from cursor array. NPT = NPT-1 DO 240 I=J,NPT X(I) = X(I+1) Y(I) = Y(I+1) 240 CONTINUE C C X (EXIT) command: C ELSE IF (LETTER.EQ.'X') THEN CALL GRETXT RETURN C C Illegal command: C ELSE CALL GRMSG('Commands are A (add), D (delete), X (exit).') END IF C GOTO 100 END pgplot/src/pgptxt.f010064400040640000322000000053300613406372300150230ustar00tjpcitmbr00000400000017C*PGPTXT -- write text at arbitrary position and angle C%void cpgptxt(float x, float y, float angle, float fjust, \ C% const char *text); C+ SUBROUTINE PGPTXT (X, Y, ANGLE, FJUST, TEXT) REAL X, Y, ANGLE, FJUST CHARACTER*(*) TEXT C C Primitive routine for drawing text. The text may be drawn at any C angle with the horizontal, and may be centered or left- or right- C justified at a specified position. Routine PGTEXT provides a C simple interface to PGPTXT for horizontal strings. Text is drawn C using the current values of attributes color-index, line-width, C character-height, and character-font. Text is NOT subject to C clipping at the edge of the window. C C Arguments: C X (input) : world x-coordinate. C Y (input) : world y-coordinate. The string is drawn with the C baseline of all the characters passing through C point (X,Y); the positioning of the string along C this line is controlled by argument FJUST. C ANGLE (input) : angle, in degrees, that the baseline is to make C with the horizontal, increasing counter-clockwise C (0.0 is horizontal). C FJUST (input) : controls horizontal justification of the string. C If FJUST = 0.0, the string will be left-justified C at the point (X,Y); if FJUST = 0.5, it will be C centered, and if FJUST = 1.0, it will be right C justified. [Other values of FJUST give other C justifications.] C TEXT (input) : the character string to be plotted. C-- C (2-May-1983) C 31-Jan-1985 - convert to Fortran-77 standard... C 13-Feb-1988 - correct a PGBBUF/PGEBUF mismatch if string is blank. C 16-Oct-1993 - erase background of opaque text. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER CI, I, L, GRTRIM REAL D, XP, YP REAL XBOX(4), YBOX(4) LOGICAL PGNOTO C IF (PGNOTO('PGPTXT')) RETURN CALL PGBBUF C L = GRTRIM(TEXT) D = 0.0 IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D) XP = PGXORG(PGID)+X*PGXSCL(PGID) - D*FJUST*COS(ANGLE/57.29578) YP = PGYORG(PGID)+Y*PGYSCL(PGID) - D*FJUST*SIN(ANGLE/57.29578) IF (PGTBCI(PGID).GE.0) THEN CALL GRQTXT (ANGLE, XP, YP, TEXT(1:L), XBOX, YBOX) DO 25 I=1,4 XBOX(I) = (XBOX(I)-PGXORG(PGID))/PGXSCL(PGID) YBOX(I) = (YBOX(I)-PGYORG(PGID))/PGYSCL(PGID) 25 CONTINUE CALL PGQCI(CI) CALL PGSCI(PGTBCI(PGID)) CALL GRFA(4, XBOX, YBOX) CALL PGSCI(CI) END IF CALL GRTEXT(.TRUE. ,ANGLE, .TRUE., XP, YP, TEXT(1:L)) 30 CALL PGEBUF END pgplot/src/pgerr1.f010064400040640000322000000055160632003403600146730ustar00tjpcitmbr00000400000017C*PGERR1 -- horizontal or vertical error bar C%void cpgerr1(int dir, float x, float y, float e, float t); C+ SUBROUTINE PGERR1 (DIR, X, Y, E, T) INTEGER DIR REAL X, Y, E REAL T C C Plot a single error bar in the direction specified by DIR. C This routine draws an error bar only; to mark the data point at C the start of the error bar, an additional call to PGPT is required. C To plot many error bars, use PGERRB. C C Arguments: C DIR (input) : direction to plot the error bar relative to C the data point. C One-sided error bar: C DIR is 1 for +X (X to X+E); C 2 for +Y (Y to Y+E); C 3 for -X (X to X-E); C 4 for -Y (Y to Y-E). C Two-sided error bar: C DIR is 5 for +/-X (X-E to X+E); C 6 for +/-Y (Y-E to Y+E). C X (input) : world x-coordinate of the data. C Y (input) : world y-coordinate of the data. C E (input) : value of error bar distance to be added to the C data position in world coordinates. C T (input) : length of terminals to be drawn at the ends C of the error bar, as a multiple of the default C length; if T = 0.0, no terminals will be drawn. C-- C 31-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO REAL XTIK, YTIK, XX, YY C IF (PGNOTO('PGERR1')) RETURN IF (DIR.LT.1 .OR. DIR.GT.6) RETURN CALL PGBBUF C C Determine terminal length. C CALL PGTIKL(T, XTIK, YTIK) C C Draw terminal at starting point if required. C IF (DIR.EQ.5) THEN XX = X-E YY = Y ELSE IF (DIR.EQ.6) THEN XX = X YY = Y-E ELSE XX = X YY = Y END IF IF (T.NE.0.0) THEN IF (DIR.EQ.5) THEN CALL GRMOVA(XX,YY-YTIK) CALL GRLINA(XX,YY+YTIK) ELSE IF (DIR.EQ.6) THEN CALL GRMOVA(XX-XTIK,YY) CALL GRLINA(XX+XTIK,YY) END IF END IF C C Draw the error bar itself. C CALL GRMOVA(XX,YY) IF (DIR.EQ.1 .OR. DIR.EQ.5) THEN XX = X+E YY = Y ELSE IF (DIR.EQ.2 .OR. DIR.EQ.6) THEN XX = X YY = Y+E ELSE IF (DIR.EQ.3) THEN XX = X-E YY = Y ELSE IF (DIR.EQ.4) THEN XX = X YY = Y-E END IF CALL GRLINA(XX,YY) C C Draw terminal at end point. C IF (T.NE.0.0) THEN IF (MOD(DIR,2).EQ.1) THEN CALL GRMOVA(XX,YY-YTIK) CALL GRLINA(XX,YY+YTIK) ELSE CALL GRMOVA(XX-XTIK,YY) CALL GRLINA(XX+XTIK,YY) END IF END IF C CALL PGEBUF END pgplot/src/pgqch.f010064400040640000322000000011060606640060600145730ustar00tjpcitmbr00000400000017C*PGQCH -- inquire character height C%void cpgqch(float *size); C+ SUBROUTINE PGQCH (SIZE) REAL SIZE C C Query the Character Size attribute (set by routine PGSCH). C C Argument: C SIZE (output) : current character size (dimensionless multiple of C the default size). C-- C 5-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGQCH')) THEN SIZE = 1.0 ELSE SIZE = PGCHSZ(PGID) END IF END pgplot/src/pgqcir.f010064400040640000322000000011760606640060700147660ustar00tjpcitmbr00000400000017C*PGQCIR -- inquire color index range C%void cpgqcir(int *icilo, int *icihi); C+ SUBROUTINE PGQCIR(ICILO, ICIHI) INTEGER ICILO, ICIHI C C Query the color index range to be used for producing images with C PGGRAY or PGIMAG, as set by routine PGSCIR or by device default. C C Arguments: C ICILO (output) : the lowest color index to use for images C ICIHI (output) : the highest color index to use for images C-- C 1994-Mar-17 : new routine [AFT/TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C--- ICILO = PGMNCI(PGID) ICIHI = PGMXCI(PGID) C END pgplot/src/pgqcs.f010064400040640000322000000075360606640060700146240ustar00tjpcitmbr00000400000017C*PGQCS -- inquire character height in a variety of units C%void cpgqcs(int units, float *xch, float *ych); C+ SUBROUTINE PGQCS(UNITS, XCH, YCH) INTEGER UNITS REAL XCH, YCH C C Return the current PGPLOT character height in a variety of units. C This routine provides facilities that are not available via PGQCH. C Use PGQCS if the character height is required in units other than C those used in PGSCH. C C The PGPLOT "character height" is a dimension that scales with the C size of the view surface and with the scale-factor specified with C routine PGSCH. The default value is 1/40th of the height or width C of the view surface (whichever is less); this value is then C multiplied by the scale-factor supplied with PGSCH. Note that it C is a nominal height only; the actual character size depends on the C font and is usually somewhat smaller. C C Arguments: C UNITS (input) : Used to specify the units of the output value: C UNITS = 0 : normalized device coordinates C UNITS = 1 : inches C UNITS = 2 : millimeters C UNITS = 3 : pixels C UNITS = 4 : world coordinates C Other values give an error message, and are C treated as 0. C XCH (output) : The character height for text written with a C vertical baseline. C YCH (output) : The character height for text written with C a horizontal baseline (the usual case). C C The character height is returned in both XCH and YCH. C C If UNITS=1 or UNITS=2, XCH and YCH both receive the same value. C C If UNITS=3, XCH receives the height in horizontal pixel units, and YCH C receives the height in vertical pixel units; on devices for which the C pixels are not square, XCH and YCH will be different. C C If UNITS=4, XCH receives the height in horizontal world coordinates C (as used for the x-axis), and YCH receives the height in vertical C world coordinates (as used for the y-axis). Unless special care has C been taken to achive equal world-coordinate scales on both axes, the C values of XCH and YCH will be different. C C If UNITS=0, XCH receives the character height as a fraction of the C horizontal dimension of the view surface, and YCH receives the C character height as a fraction of the vertical dimension of the view C surface. C-- C 15-Oct-1992 - new routine [MCS]. C 4-Dec-1992 - added more explanation [TJP]. C 5-Sep-1995 - add UNITS=4; correct error for non-square pixels [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL RATIO C Conversion factor inches -> mm REAL INTOMM PARAMETER (INTOMM=25.4) C----------------------------------------------------------------------- IF (PGNOTO('PGQCS')) RETURN RATIO = PGYPIN(PGID)/PGXPIN(PGID) C C Return the character height in the required units. C C Inches. IF (UNITS.EQ.1) THEN XCH = PGYSP(PGID)/PGXPIN(PGID) YCH = XCH C Millimeters. ELSE IF (UNITS.EQ.2) THEN XCH = PGYSP(PGID)/PGXPIN(PGID) * INTOMM YCH = XCH C Pixels. ELSE IF (UNITS.EQ.3) THEN XCH = PGYSP(PGID) YCH = PGYSP(PGID)*RATIO C World coordinates. ELSE IF (UNITS.EQ.4) THEN XCH = PGYSP(PGID)/PGXSCL(PGID) YCH = PGYSP(PGID)*RATIO/PGYSCL(PGID) C Normalized device coords, or C unknown. ELSE XCH = PGYSP(PGID)/PGXSZ(PGID) YCH = PGYSP(PGID)*RATIO/PGYSZ(PGID) IF (UNITS.NE.0) : CALL GRWARN('Invalid "UNITS" argument in PGQCS.') END IF END pgplot/src/pgqhs.f010064400040640000322000000023110606640061000146050ustar00tjpcitmbr00000400000017C*PGQHS -- inquire hatching style C%void cpgqhs(float *angle, float *sepn, float* phase); C+ SUBROUTINE PGQHS (ANGLE, SEPN, PHASE) REAL ANGLE, SEPN, PHASE C C Query the style to be used hatching (fill area with fill-style 3). C C Arguments: C ANGLE (output) : the angle the hatch lines make with the C horizontal, in degrees, increasing C counterclockwise (this is an angle on the C view surface, not in world-coordinate space). C SEPN (output) : the spacing of the hatch lines. The unit spacing C is 1 percent of the smaller of the height or C width of the view surface. C PHASE (output) : a real number between 0 and 1; the hatch lines C are displaced by this fraction of SEPN from a C fixed reference. Adjacent regions hatched with the C same PHASE have contiguous hatch lines. C-- C 26-Feb-1995 - new routine [TJP]. C 19-Jun-1995 - correct synopsis [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C ANGLE = PGHSA(PGID) SEPN = PGHSS(PGID) PHASE = PGHSP(PGID) C END pgplot/src/pgqitf.f010064400040640000322000000012010606640061100147530ustar00tjpcitmbr00000400000017C*PGQITF -- inquire image transfer function C%void cpgqitf(int *itf); C+ SUBROUTINE PGQITF (ITF) INTEGER ITF C C Return the Image Transfer Function as set by default or by a previous C call to PGSITF. The Image Transfer Function is used by routines C PGIMAG, PGGRAY, and PGWEDG. C C Argument: C ITF (output) : type of transfer function (see PGSITF) C-- C 15-Sep-1994 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGQITF')) THEN ITF = 0 ELSE ITF = PGITF(PGID) END IF END pgplot/src/pgqtbg.f010064400040640000322000000010710606640061200147530ustar00tjpcitmbr00000400000017C*PGQTBG -- inquire text background color index C%void cpgqtbg(int *tbci); C+ SUBROUTINE PGQTBG (TBCI) INTEGER TBCI C C Query the current Text Background Color Index (set by routine C PGSTBG). C C Argument: C TBCI (output) : receives the current text background color index. C-- C 16-Oct-1993 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGQTBG')) THEN TBCI = 0 ELSE TBCI = PGTBCI(PGID) END IF END pgplot/src/grscrl.f010064400040640000322000000021700630515731400147700ustar00tjpcitmbr00000400000017C GRSCRL -- scroll pixels in viewport C+ SUBROUTINE GRSCRL (DX, DY) INTEGER DX, DY C C Shift the pixels in the viewport by DX and DY in device coordinates. C-- C 24-Feb-97: new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF, LCHR REAL RBUF(6) CHARACTER*8 CHR C C Do nothing if device is not open or not in appropriate state. C IF (GRCIDE.LT.1) RETURN IF (.NOT.GRPLTD(GRCIDE)) RETURN C C If device has scroll capability, use it. The arguments in C RBUF are: (1..4) current viewport in device coordinates; C (5..6) scroll displacement in world coordinates. C IF (GRGCAP(GRCIDE)(11:11).EQ.'S') THEN RBUF(1) = NINT(GRXMIN(GRCIDE)) RBUF(2) = NINT(GRYMIN(GRCIDE)) RBUF(3) = NINT(GRXMAX(GRCIDE)) RBUF(4) = NINT(GRYMAX(GRCIDE)) RBUF(5) = DX RBUF(6) = DY NBUF = 6 LCHR = 0 CALL GREXEC(GRGTYP,30,RBUF,NBUF,CHR,LCHR) C C Otherwise, report an error. C ELSE CALL GRWARN('Device does not support scrolling') END IF END pgplot/src/grctoi.f010064400040640000322000000030070634510674300147670ustar00tjpcitmbr00000400000017C*GRCTOI -- convert character string to integer C+ INTEGER FUNCTION GRCTOI (S, I) CHARACTER*(*) S INTEGER I C C GRCTOI: attempt to read an integer from a character string, and return C the result. No attempt is made to avoid integer overflow. A valid C integer is any sequence of decimal digits. C C Returns: C GRCTOI : the value of the integer; if the first character C read is not a decimal digit, the value returned C is zero. C Arguments: C S (input) : character string to be parsed. C I (in/out) : on input, I is the index of the first character C in S to be examined; on output, either it points C to the next character after a valid integer, or C it is equal to LEN(S)+1. C C-- C 1985 Oct 8 - New routine, based on CTOI (T. J. Pearson). C 1997 Jun 3 - allow leading + or - sign (TJP). C----------------------------------------------------------------------- INTEGER K, SIGN, X CHARACTER*1 DIGITS(0:9) DATA DIGITS/'0','1','2','3','4','5','6','7','8','9'/ C X = 0 SIGN = +1 IF (I.GT.LEN(S)) GOTO 30 IF (S(I:I).EQ.'+') THEN I = I+1 ELSE IF (S(I:I).EQ.'-') THEN I = I+1 SIGN = -1 END IF 10 IF (I.GT.LEN(S)) GOTO 30 DO 20 K=0,9 IF (S(I:I).EQ.DIGITS(K)) THEN X = X*10 + K I = I+1 GOTO 10 END IF 20 CONTINUE 30 GRCTOI = X*SIGN RETURN END pgplot/src/pgldev.f010064400040640000322000000026570631356402600147700ustar00tjpcitmbr00000400000017C*PGLDEV -- list available device types on standard output C%void cpgldev(void); C+ SUBROUTINE PGLDEV C C Writes (to standard output) a list of all device types available in C the current PGPLOT installation. C C Arguments: none. C-- C 5-Aug-1986 - [AFT]. C 1-Aug-1988 - add version number [TJP]. C 24-Apr-1989 - add copyright notice [TJP]. C 13-Dec-1990 - changed warnings to messages [TJP]. C 26-Feb-1997 - revised description [TJP]. C 18-Mar-1997 - revised [TJP]. C----------------------------------------------------------------------- CHARACTER*16 GVER INTEGER L CHARACTER*10 T CHARACTER*64 D INTEGER I, N, TLEN, DLEN, INTER C C Initialize PGPLOT if necessary. C CALL PGINIT C C Report version and copyright. C CALL PGQINF('VERSION', GVER, L) CALL GRMSG('PGPLOT '//GVER(:L)// 1 ' Copyright 1997 California Institute of Technology') C C Find number of device types. C CALL PGQNDT(N) C C Loop through device-type list (twice). CALL GRMSG('Interactive devices:') DO 10 I=1,N CALL PGQDT(I, T, TLEN, D, DLEN, INTER) IF (TLEN.GT.0 .AND. INTER.EQ.1) : CALL GRMSG(' '//T//' '//D(1:DLEN)) 10 CONTINUE CALL GRMSG('Non-interactive file formats:') DO 20 I=1,N CALL PGQDT(I, T, TLEN, D, DLEN, INTER) IF (TLEN.GT.0 .AND. INTER.EQ.0) : CALL GRMSG(' '//T//' '//D(1:DLEN)) 20 CONTINUE C END pgplot/src/pgscir.f010064400040640000322000000014030606640061600147610ustar00tjpcitmbr00000400000017C*PGSCIR -- set color index range C%void cpgscir(int icilo, int icihi); C+ SUBROUTINE PGSCIR(ICILO, ICIHI) INTEGER ICILO, ICIHI C C Set the color index range to be used for producing images with C PGGRAY or PGIMAG. If the range is not all within the range supported C by the device, a smaller range will be used. The number of C different colors available for images is ICIHI-ICILO+1. C C Arguments: C ICILO (input) : the lowest color index to use for images C ICIHI (input) : the highest color index to use for images C-- C 1994-Mar-17 : new routine [AFT/TJP]. C--- INCLUDE 'pgplot.inc' INTEGER IC1, IC2 C--- CALL GRQCOL(IC1,IC2) PGMNCI(PGID) = MIN(IC2,MAX(IC1,ICILO)) PGMXCI(PGID) = MIN(IC2,MAX(IC1,ICIHI)) C END pgplot/src/pgsfs.f010064400040640000322000000026410606640062000146140ustar00tjpcitmbr00000400000017C*PGSFS -- set fill-area style C%void cpgsfs(int fs); C+ SUBROUTINE PGSFS (FS) INTEGER FS C C Set the Fill-Area Style attribute for subsequent area-fill by C PGPOLY, PGRECT, or PGCIRC. Four different styles are available: C solid (fill polygon with solid color of the current color-index), C outline (draw outline of polygon only, using current line attributes), C hatched (shade interior of polygon with parallel lines, using C current line attributes), or cross-hatched. The orientation and C spacing of hatch lines can be specified with routine PGSHS (set C hatch style). C C Argument: C FS (input) : the fill-area style to be used for subsequent C plotting: C FS = 1 => solid (default) C FS = 2 => outline C FS = 3 => hatched C FS = 4 => cross-hatched C Other values give an error message and are C treated as 2. C-- C 21-Oct-1985 - new routine [TJP]. C 17-Dec-1990 - pass to GR level [TJP]. C 6-Mar-1995 - add styles 3 and 4 [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSFS')) RETURN IF (FS.LT.1 .OR. FS.GT.4) THEN CALL GRWARN('illegal fill-area style requested') PGFAS(PGID) = 2 ELSE PGFAS(PGID) = FS END IF END pgplot/src/pgstbg.f010064400040640000322000000022200606640062200147530ustar00tjpcitmbr00000400000017C*PGSTBG -- set text background color index C%void cpgstbg(int tbci); C+ SUBROUTINE PGSTBG (TBCI) INTEGER TBCI C C Set the Text Background Color Index for subsequent text. By default C text does not obscure underlying graphics. If the text background C color index is positive, however, text is opaque: the bounding box C of the text is filled with the color specified by PGSTBG before C drawing the text characters in the current color index set by PGSCI. C Use color index 0 to erase underlying graphics before drawing text. C C Argument: C TBCI (input) : the color index to be used for the background C for subsequent text plotting: C TBCI < 0 => transparent (default) C TBCI >= 0 => text will be drawn on an opaque C background with color index TBCI. C-- C 16-Oct-1993 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSTBG')) RETURN IF (TBCI.LT.0) THEN PGTBCI(PGID) = -1 ELSE PGTBCI(PGID) = TBCI END IF END pgplot/src/pgsitf.f010064400040640000322000000017160606640062100147710ustar00tjpcitmbr00000400000017C*PGSITF -- set image transfer function C%void cpgsitf(int itf); C+ SUBROUTINE PGSITF (ITF) INTEGER ITF C C Set the Image Transfer Function for subsequent images drawn by C PGIMAG, PGGRAY, or PGWEDG. The Image Transfer Function is used C to map array values into the available range of color indices C specified with routine PGSCIR or (for PGGRAY on some devices) C into dot density. C C Argument: C ITF (input) : type of transfer function: C ITF = 0 : linear C ITF = 1 : logarithmic C ITF = 2 : square-root C-- C 15-Sep-1994 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSITF')) RETURN IF (ITF.LT.0 .OR. ITF.GT.2) THEN PGITF(PGID) = 0 CALL GRWARN('PGSITF: argument must be 0, 1, or 2') ELSE PGITF(PGID) = ITF END IF END pgplot/src/pgsubp.f010064400040640000322000000052650622153757100150100ustar00tjpcitmbr00000400000017C*PGSUBP -- subdivide view surface into panels C%void cpgsubp(int nxsub, int nysub); C+ SUBROUTINE PGSUBP (NXSUB, NYSUB) INTEGER NXSUB, NYSUB C C PGPLOT divides the physical surface of the plotting device (screen, C window, or sheet of paper) into NXSUB x NYSUB `panels'. When the C view surface is sub-divided in this way, PGPAGE moves to the next C panel, not the next physical page. The initial subdivision of the C view surface is set in the call to PGBEG. When PGSUBP is called, C it forces the next call to PGPAGE to start a new physical page, C subdivided in the manner indicated. No plotting should be done C between a call of PGSUBP and a call of PGPAGE (or PGENV, which calls C PGPAGE). C C If NXSUB > 0, PGPLOT uses the panels in row order; if <0, C PGPLOT uses them in column order, e.g., C C NXSUB=3, NYSUB=2 NXSUB=-3, NYSUB=2 C C +-----+-----+-----+ +-----+-----+-----+ C | 1 | 2 | 3 | | 1 | 3 | 5 | C +-----+-----+-----+ +-----+-----+-----+ C | 4 | 5 | 6 | | 2 | 4 | 6 | C +-----+-----+-----+ +-----+-----+-----+ C C PGPLOT advances from one panels to the next when PGPAGE is called, C clearing the screen or starting a new page when the last panel has C been used. It is also possible to jump from one panel to another C in random order by calling PGPANL. C C Arguments: C NXSUB (input) : the number of subdivisions of the view surface in C X (>0 or <0). C NYSUB (input) : the number of subdivisions of the view surface in C Y (>0). C-- C 15-Nov-1993 [TJP] - new routine. C 19-Feb-1994 [TJP] - rescale viewport when panel size changes. C 23-Sep-1996 [TJP] - correct bug in assignment of PGROWS. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL CH, XFSZ, YFSZ LOGICAL PGNOTO REAL XVP1, XVP2, YVP1, YVP2 C IF (PGNOTO('PGSUBP')) RETURN C C Find current character size and viewport (NDC). C CALL PGQCH(CH) CALL PGQVP(0, XVP1, XVP2, YVP1, YVP2) C C Set the subdivisions. C XFSZ = PGNX(PGID)*PGXSZ(PGID) YFSZ = PGNY(PGID)*PGYSZ(PGID) PGROWS(PGID) = (NXSUB.GE.0) PGNX(PGID) = MAX(ABS(NXSUB),1) PGNY(PGID) = MAX(ABS(NYSUB),1) PGXSZ(PGID) = XFSZ/PGNX(PGID) PGYSZ(PGID) = YFSZ/PGNY(PGID) C C The current panel is the last on the physical page, to force C a new physical page at next PGPAGE. C PGNXC(PGID) = PGNX(PGID) PGNYC(PGID) = PGNY(PGID) C C Rescale the character size and viewport to the new panel size. C CALL PGSCH(CH) CALL PGSVP(XVP1, XVP2, YVP1, YVP2) C END pgplot/src/pgiden.f010064400040640000322000000021100606640057600147410ustar00tjpcitmbr00000400000017C*PGIDEN -- write username, date, and time at bottom of plot C%void cpgiden(void); C+ SUBROUTINE PGIDEN C C Write username, date, and time at bottom of plot. C C Arguments: none. C-- C 9-Feb-1988 C 10-Sep-1990 : adjust position of text [TJP] C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER L, M, CF, CI, LW CHARACTER*64 TEXT REAL D, CH C CALL PGBBUF C C Get information for annotation. C CALL GRUSER(TEXT, L) TEXT(L+1:) = ' ' CALL GRDATE(TEXT(L+2:), M) L = L+1+M C C Save current attributes. C CALL PGQCF(CF) CALL PGQCI(CI) CALL PGQLW(LW) CALL PGQCH(CH) C C Change attributes and write text. C CALL PGSCF(1) CALL PGSCI(1) CALL PGSLW(1) CALL PGSCH(0.6) CALL GRLEN(TEXT(1:L),D) CALL GRTEXT(.FALSE., 0.0, .TRUE., PGXSZ(PGID)-D-2.0, 1 2.0+PGYSZ(PGID)/130.0, TEXT(1:L)) C C Restore attributes. C CALL PGSCF(CF) CALL PGSCI(CI) CALL PGSLW(LW) CALL PGSCH(CH) CALL PGEBUF C END pgplot/src/pgrect.f010064400040640000322000000030570606640061400147630ustar00tjpcitmbr00000400000017C*PGRECT -- draw a rectangle, using fill-area attributes C%void cpgrect(float x1, float x2, float y1, float y2); C+ SUBROUTINE PGRECT (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C This routine can be used instead of PGPOLY for the special case of C drawing a rectangle aligned with the coordinate axes; only two C vertices need be specified instead of four. On most devices, it is C faster to use PGRECT than PGPOLY for drawing rectangles. The C rectangle has vertices at (X1,Y1), (X1,Y2), (X2,Y2), and (X2,Y1). C C Arguments: C X1, X2 (input) : the horizontal range of the rectangle. C Y1, Y2 (input) : the vertical range of the rectangle. C-- C 21-Nov-1986 - [TJP]. C 22-Mar-1988 - use GRRECT for fill [TJP]. C 6-Mar-1995 - add hatching (by calling PGHTCH) [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL XP(4), YP(4) C CALL PGBBUF C C Outline only. C IF (PGFAS(PGID).EQ.2) THEN CALL GRMOVA(X1,Y1) CALL GRLINA(X1,Y2) CALL GRLINA(X2,Y2) CALL GRLINA(X2,Y1) CALL GRLINA(X1,Y1) C C Hatching. C ELSE IF (PGFAS(PGID).EQ.3 .OR. PGFAS(PGID).EQ.4) THEN XP(1) = X1 XP(2) = X1 XP(3) = X2 XP(4) = X2 YP(1) = Y1 YP(2) = Y2 YP(3) = Y2 YP(4) = Y1 CALL PGHTCH(4, XP, YP, 0.0) IF (PGFAS(PGID).EQ.4) CALL PGHTCH(4, XP, YP, 90.0) C C Solid fill. C ELSE CALL GRRECT(X1,Y1,X2,Y2) CALL GRMOVA(X1,Y1) END IF CALL PGEBUF END ttributes C%void cpgrect(float x1, float x2, float y1, float y2); C+ SUBROUTINE PGRECT (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C This routine can be used instead of PGPOLY for the special case of C drawing a rectangle aligned with the coordinate axes; only two C vertices need be specified instead of four. On most devices, it is C faster to use PGRECT than PGPOLY for drawing rectangles. The C rectangle has vertices at (X1,Y1), (X1,Y2), (X2,Y2), and pgplot/src/pgvsiz.f010064400040640000322000000040460606640062500150220ustar00tjpcitmbr00000400000017C*PGVSIZ -- set viewport (inches) C%void cpgvsiz(float xleft, float xright, float ybot, float ytop); C+ SUBROUTINE PGVSIZ (XLEFT, XRIGHT, YBOT, YTOP) REAL XLEFT, XRIGHT, YBOT, YTOP C C Change the size and position of the viewport, specifying C the viewport in physical device coordinates (inches). The C viewport is the rectangle on the view surface "through" C which one views the graph. All the PG routines which plot lines C etc. plot them within the viewport, and lines are truncated at C the edge of the viewport (except for axes, labels etc drawn with C PGBOX or PGLAB). The region of world space (the coordinate C space of the graph) which is visible through the viewport is C specified by a call to PGSWIN. It is legal to request a C viewport larger than the view surface; only the part which C appears on the view surface will be plotted. C C Arguments: C XLEFT (input) : x-coordinate of left hand edge of viewport, in C inches from left edge of view surface. C XRIGHT (input) : x-coordinate of right hand edge of viewport, in C inches from left edge of view surface. C YBOT (input) : y-coordinate of bottom edge of viewport, in C inches from bottom of view surface. C YTOP (input) : y-coordinate of top edge of viewport, in inches C from bottom of view surface. C-- C 13-Dec-1990 Make errors non-fatal [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGVSIZ')) RETURN IF (XLEFT.GE.XRIGHT .OR. YBOT.GE.YTOP) THEN CALL GRWARN('PGVSIZ ignored: invalid arguments') RETURN END IF C PGXLEN(PGID) = (XRIGHT-XLEFT)*PGXPIN(PGID) PGYLEN(PGID) = (YTOP-YBOT)*PGYPIN(PGID) PGXVP(PGID) = XLEFT*PGXPIN(PGID) PGYVP(PGID) = YBOT*PGYPIN(PGID) PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID) PGYOFF(PGID) = PGYVP(PGID) + 1 (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID) CALL PGVW END pgplot/src/pgerrb.f010064400040640000322000000066660632003461400147650ustar00tjpcitmbr00000400000017C*PGERRB -- horizontal or vertical error bar C%void cpgerrb(int dir, int n, const float *x, const float *y, \ C% const float *e, float t); C+ SUBROUTINE PGERRB (DIR, N, X, Y, E, T) INTEGER DIR, N REAL X(*), Y(*), E(*) REAL T C C Plot error bars in the direction specified by DIR. C This routine draws an error bar only; to mark the data point at C the start of the error bar, an additional call to PGPT is required. C C Arguments: C DIR (input) : direction to plot the error bar relative to C the data point. C One-sided error bar: C DIR is 1 for +X (X to X+E); C 2 for +Y (Y to Y+E); C 3 for -X (X to X-E); C 4 for -Y (Y to Y-E). C Two-sided error bar: C DIR is 5 for +/-X (X-E to X+E); C 6 for +/-Y (Y-E to Y+E). C N (input) : number of error bars to plot. C X (input) : world x-coordinates of the data. C Y (input) : world y-coordinates of the data. C E (input) : value of error bar distance to be added to the C data position in world coordinates. C T (input) : length of terminals to be drawn at the ends C of the error bar, as a multiple of the default C length; if T = 0.0, no terminals will be drawn. C C Note: the dimension of arrays X, Y, and E must be greater C than or equal to N. If N is 1, X, Y, and E may be scalar C variables, or expressions. C-- C 1-Mar-1991 - new routine [JM]. C 20-Apr-1992 - correct bug [ALF, TJP]. C 28-Mar-1995 - add options DIR = 5 or 6 [TJP]. C 31-Mar-1997 - use pgtikl [TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL PGNOTO REAL XTIK, YTIK, XX, YY C IF (PGNOTO('PGERRB')) RETURN IF (N.LT.1) RETURN IF (DIR.LT.1 .OR. DIR.GT.6) RETURN CALL PGBBUF C C Determine terminal length. C CALL PGTIKL(T, XTIK, YTIK) C C Loop through points. C DO 10 I=1,N C C Draw terminal at starting point if required. C IF (DIR.EQ.5) THEN XX = X(I)-E(I) YY = Y(I) ELSE IF (DIR.EQ.6) THEN XX = X(I) YY = Y(I)-E(I) ELSE XX = X(I) YY = Y(I) END IF IF (T.NE.0.0) THEN IF (DIR.EQ.5) THEN CALL GRMOVA(XX,YY-YTIK) CALL GRLINA(XX,YY+YTIK) ELSE IF (DIR.EQ.6) THEN CALL GRMOVA(XX-XTIK,YY) CALL GRLINA(XX+XTIK,YY) END IF END IF C C Draw the error bar itself. C CALL GRMOVA(XX,YY) IF (DIR.EQ.1 .OR. DIR.EQ.5) THEN XX = X(I)+E(I) YY = Y(I) ELSE IF (DIR.EQ.2 .OR. DIR.EQ.6) THEN XX = X(I) YY = Y(I)+E(I) ELSE IF (DIR.EQ.3) THEN XX = X(I)-E(I) YY = Y(I) ELSE IF (DIR.EQ.4) THEN XX = X(I) YY = Y(I)-E(I) END IF CALL GRLINA(XX,YY) C C Draw terminal at end point. C IF (T.NE.0.0) THEN IF (MOD(DIR,2).EQ.1) THEN CALL GRMOVA(XX,YY-YTIK) CALL GRLINA(XX,YY+YTIK) ELSE CALL GRMOVA(XX-XTIK,YY) CALL GRLINA(XX+XTIK,YY) END IF END IF C 10 CONTINUE CALL PGEBUF END pgplot/src/pgwnad.f010064400040640000322000000043250606640062700147620ustar00tjpcitmbr00000400000017C*PGWNAD -- set window and adjust viewport to same aspect ratio C%void cpgwnad(float x1, float x2, float y1, float y2); C+ SUBROUTINE PGWNAD (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C Change the window in world coordinate space that is to be mapped on C to the viewport, and simultaneously adjust the viewport so that the C world-coordinate scales are equal in x and y. The new viewport is C the largest one that can fit within the previously set viewport C while retaining the required aspect ratio. C C Arguments: C X1 (input) : the x-coordinate of the bottom left corner C of the viewport. C X2 (input) : the x-coordinate of the top right corner C of the viewport (note X2 may be less than X1). C Y1 (input) : the y-coordinate of the bottom left corner C of the viewport. C Y2 (input) : the y-coordinate of the top right corner of the C viewport (note Y2 may be less than Y1). C-- C 25-Sep-1985 - new routine (TJP). C 31-May-1989 - correct error: XVP and YVP not set (TJP). C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL SCALE,OXLEN,OYLEN C IF (PGNOTO('PGWNAD')) RETURN C C If invalid arguments are specified, issue warning and leave window C unchanged. C IF (X1.EQ.X2) THEN CALL GRWARN('invalid x limits in PGWNAD: X1 = X2.') ELSE IF (Y1.EQ.Y2) THEN CALL GRWARN('invalid y limits in PGWNAD: Y1 = Y2.') ELSE SCALE = MIN(PGXLEN(PGID)/ABS(X2-X1)/PGXPIN(PGID), 1 PGYLEN(PGID)/ABS(Y2-Y1)/PGYPIN(PGID)) PGXSCL(PGID) = SCALE*PGXPIN(PGID) PGYSCL(PGID) = SCALE*PGYPIN(PGID) OXLEN = PGXLEN(PGID) OYLEN = PGYLEN(PGID) PGXLEN(PGID) = PGXSCL(PGID)*ABS(X2-X1) PGYLEN(PGID) = PGYSCL(PGID)*ABS(Y2-Y1) PGXVP(PGID) = PGXVP(PGID) + 0.5*(OXLEN-PGXLEN(PGID)) PGYVP(PGID) = PGYVP(PGID) + 0.5*(OYLEN-PGYLEN(PGID)) PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID) PGYOFF(PGID) = PGYVP(PGID) + 1 (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID) CALL PGSWIN(X1, X2, Y1, Y2) END IF END n world coordinate space that is to be mapped on C to the viewport, and simultaneously adjust the viewport so that the C world-coordinate scales are equal in x and y. The new viewport is C the largest one that can fit within the previously set viewport C while retaining the required aspect ratio. Cpgplot/src/pgband.f010064400040640000322000000113160606640102200147210ustar00tjpcitmbr00000400000017C*PGBAND -- read cursor position, with anchor C%int cpgband(int mode, int posn, float xref, float yref, float *x,\ C% float *y, char *ch_scalar); C+ INTEGER FUNCTION PGBAND (MODE, POSN, XREF, YREF, X, Y, CH) INTEGER MODE, POSN REAL XREF, YREF, X, Y CHARACTER*(*) CH C C Read the cursor position and a character typed by the user. C The position is returned in world coordinates. PGBAND positions C the cursor at the position specified (if POSN=1), allows the user to C move the cursor using the mouse or arrow keys or whatever is available C on the device. When he has positioned the cursor, the user types a C single character on the keyboard; PGBAND then returns this C character and the new cursor position (in world coordinates). C C Some interactive devices offer a selection of cursor types, C implemented as thin lines that move with the cursor, but without C erasing underlying graphics. Of these types, some extend between C a stationary anchor-point at XREF,YREF, and the position of the C cursor, while others simply follow the cursor without changing shape C or size. The cursor type is specified with one of the following MODE C values. Cursor types that are not supported by a given device, are C treated as MODE=0. C C -- If MODE=0, the anchor point is ignored and the routine behaves C like PGCURS. C -- If MODE=1, a straight line is drawn joining the anchor point C and the cursor position. C -- If MODE=2, a hollow rectangle is extended as the cursor is moved, C with one vertex at the anchor point and the opposite vertex at the C current cursor position; the edges of the rectangle are horizontal C and vertical. C -- If MODE=3, two horizontal lines are extended across the width of C the display, one drawn through the anchor point and the other C through the moving cursor position. This could be used to select C a Y-axis range when one end of the range is known. C -- If MODE=4, two vertical lines are extended over the height of C the display, one drawn through the anchor point and the other C through the moving cursor position. This could be used to select an C X-axis range when one end of the range is known. C -- If MODE=5, a horizontal line is extended through the cursor C position over the width of the display. This could be used to select C an X-axis value such as the start of an X-axis range. The anchor point C is ignored. C -- If MODE=6, a vertical line is extended through the cursor C position over the height of the display. This could be used to select C a Y-axis value such as the start of a Y-axis range. The anchor point C is ignored. C -- If MODE=7, a cross-hair, centered on the cursor, is extended over C the width and height of the display. The anchor point is ignored. C C Returns: C PGBAND : 1 if the call was successful; 0 if the device C has no cursor or some other error occurs. C Arguments: C MODE (input) : display mode (0, 1, ..7: see above). C POSN (input) : if POSN=1, PGBAND attempts to place the cursor C at point (X,Y); if POSN=0, it leaves the cursor C at its current position. (On some devices this C request may be ignored.) C XREF (input) : the world x-coordinate of the anchor point. C YREF (input) : the world y-coordinate of the anchor point. C X (in/out) : the world x-coordinate of the cursor. C Y (in/out) : the world y-coordinate of the cursor. C CH (output) : the character typed by the user; if the device has C no cursor or if some other error occurs, the value C CHAR(0) [ASCII NUL character] is returned. C C Note: The cursor coordinates (X,Y) may be changed by PGBAND even if C the device has no cursor or if the user does not move the cursor. C Under these circumstances, the position returned in (X,Y) is that of C the pixel nearest to the requested position. C-- C 7-Sep-1994 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER GRCURS, I, J, IREF, JREF LOGICAL PGNOTO C IF (PGNOTO('PGBAND')) THEN CH = CHAR(0) PGBAND = 0 RETURN END IF IF (MODE.LT.0 .OR. MODE.GT.7) CALL GRWARN( : 'Invalid MODE argument in PGBAND') IF (POSN.LT.0 .OR. POSN.GT.1) CALL GRWARN( : 'Invalid POSN argument in PGBAND') C I = NINT(PGXORG(PGID) + X*PGXSCL(PGID)) J = NINT(PGYORG(PGID) + Y*PGYSCL(PGID)) IREF = NINT(PGXORG(PGID) + XREF*PGXSCL(PGID)) JREF = NINT(PGYORG(PGID) + YREF*PGYSCL(PGID)) PGBAND = GRCURS(PGID,I,J,IREF,JREF,MODE,POSN,CH) X = (I - PGXORG(PGID))/PGXSCL(PGID) Y = (J - PGYORG(PGID))/PGYSCL(PGID) CALL GRTERM END pgplot/src/pgclos.f010064400040640000322000000020260674243464600147760ustar00tjpcitmbr00000400000017C*PGCLOS -- close the selected graphics device C%void cpgclos(void); C+ SUBROUTINE PGCLOS C C Close the currently selected graphics device. After the device has C been closed, either another open device must be selected with PGSLCT C or another device must be opened with PGOPEN before any further C plotting can be done. If the call to PGCLOS is omitted, some or all C of the plot may be lost. C C [This routine was added to PGPLOT in Version 5.1.0. Older programs C use PGEND instead.] C C Arguments: none C-- C 22-Dec-1995 - new routine, derived from the old PGEND. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*16 DEFSTR LOGICAL PGNOTO C IF (.NOT.PGNOTO('PGCLOS')) THEN CALL GRTERM IF (PGPRMP(PGID)) THEN CALL GRQCAP(DEFSTR) IF (DEFSTR(8:8).EQ.'V') CALL GRPROM END IF CALL GRCLOS PGDEVS(PGID) = 0 PGID = 0 END IF C WRITE (*,*) 'PGCLOS', PGID, ':', PGDEVS END pgplot/src/pgerrx.f010064400040640000322000000034250632003436000147770ustar00tjpcitmbr00000400000017C*PGERRX -- horizontal error bar C%void cpgerrx(int n, const float *x1, const float *x2, \ C% const float *y, float t); C+ SUBROUTINE PGERRX (N, X1, X2, Y, T) INTEGER N REAL X1(*), X2(*), Y(*) REAL T C C Plot horizontal error bars. C This routine draws an error bar only; to mark the data point in C the middle of the error bar, an additional call to PGPT or C PGERRY is required. C C Arguments: C N (input) : number of error bars to plot. C X1 (input) : world x-coordinates of lower end of the C error bars. C X2 (input) : world x-coordinates of upper end of the C error bars. C Y (input) : world y-coordinates of the data. C T (input) : length of terminals to be drawn at the ends C of the error bar, as a multiple of the default C length; if T = 0.0, no terminals will be drawn. C C Note: the dimension of arrays X1, X2, and Y must be greater C than or equal to N. If N is 1, X1, X2, and Y may be scalar C variables, or expressions, eg: C CALL PGERRX(1,X-SIGMA,X+SIGMA,Y) C-- C (6-Oct-1983) C 31-Mar-1997 - use pgtikl [TJP[. C----------------------------------------------------------------------- INTEGER I LOGICAL PGNOTO REAL XTIK, YTIK C IF (PGNOTO('PGERRX')) RETURN IF (N.LT.1) RETURN CALL PGBBUF C CALL PGTIKL(T, XTIK, YTIK) DO 10 I=1,N IF (T.NE.0.0) THEN CALL GRMOVA(X1(I),Y(I)-YTIK) CALL GRLINA(X1(I),Y(I)+YTIK) END IF CALL GRMOVA(X1(I),Y(I)) CALL GRLINA(X2(I),Y(I)) IF (T.NE.0.0) THEN CALL GRMOVA(X2(I),Y(I)-YTIK) CALL GRLINA(X2(I),Y(I)+YTIK) END IF 10 CONTINUE CALL PGEBUF END an error bar only; to mark the data point in C the middle of the error bar, an additional call to PGPT or C PGERRY is required. C C Arguments: C N (input) : number of error bars to plot. C X1 (input) : world x-coordinates pgplot/src/pgerry.f010064400040640000322000000034170632003447400150070ustar00tjpcitmbr00000400000017C*PGERRY -- vertical error bar C%void cpgerry(int n, const float *x, const float *y1, \ C% const float *y2, float t); C+ SUBROUTINE PGERRY (N, X, Y1, Y2, T) INTEGER N REAL X(*), Y1(*), Y2(*) REAL T C C Plot vertical error bars. C This routine draws an error bar only; to mark the data point in C the middle of the error bar, an additional call to PGPT or C PGERRX is required. C C Arguments: C N (input) : number of error bars to plot. C X (input) : world x-coordinates of the data. C Y1 (input) : world y-coordinates of top end of the C error bars. C Y2 (input) : world y-coordinates of bottom end of the C error bars. C T (input) : length of terminals to be drawn at the ends C of the error bar, as a multiple of the default C length; if T = 0.0, no terminals will be drawn. C C Note: the dimension of arrays X, Y1, and Y2 must be greater C than or equal to N. If N is 1, X, Y1, and Y2 may be scalar C variables or expressions, eg: C CALL PGERRY(1,X,Y+SIGMA,Y-SIGMA) C-- C (6-Oct-1983) C 31-Mar-1997 - use pgtikl [TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL PGNOTO REAL XTIK, YTIK C IF (PGNOTO('PGERRY')) RETURN IF (N.LT.1) RETURN CALL PGBBUF C CALL PGTIKL(T, XTIK, YTIK) DO 10 I=1,N IF (T.NE.0.0) THEN CALL GRMOVA(X(I)-XTIK,Y1(I)) CALL GRLINA(X(I)+XTIK,Y1(I)) END IF CALL GRMOVA(X(I),Y1(I)) CALL GRLINA(X(I),Y2(I)) IF (T.NE.0.0) THEN CALL GRMOVA(X(I)-XTIK,Y2(I)) CALL GRLINA(X(I)+XTIK,Y2(I)) END IF 10 CONTINUE CALL PGEBUF END pgplot/src/pggray.f010064400040640000322000000115520614346530100147670ustar00tjpcitmbr00000400000017C*PGGRAY -- gray-scale map of a 2D data array C%void cpggray(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float fg, float bg, const float *tr); C+ SUBROUTINE PGGRAY (A, IDIM, JDIM, I1, I2, J1, J2, 1 FG, BG, TR) INTEGER IDIM, JDIM, I1, I2, J1, J2 REAL A(IDIM,JDIM), FG, BG, TR(6) C C Draw gray-scale map of an array in current window. The subsection C of the array A defined by indices (I1:I2, J1:J2) is mapped onto C the view surface world-coordinate system by the transformation C matrix TR. The resulting quadrilateral region is clipped at the edge C of the window and shaded with the shade at each point determined C by the corresponding array value. The shade is a number in the C range 0 to 1 obtained by linear interpolation between the background C level (BG) and the foreground level (FG), i.e., C C shade = [A(i,j) - BG] / [FG - BG] C C The background level BG can be either less than or greater than the C foreground level FG. Points in the array that are outside the range C BG to FG are assigned shade 0 or 1 as appropriate. C C PGGRAY uses two different algorithms, depending how many color C indices are available in the color index range specified for images. C (This range is set with routine PGSCIR, and the current or default C range can be queried by calling routine PGQCIR). C C If 16 or more color indices are available, PGGRAY first assigns C color representations to these color indices to give a linear ramp C between the background color (color index 0) and the foreground color C (color index 1), and then calls PGIMAG to draw the image using these C color indices. In this mode, the shaded region is "opaque": every C pixel is assigned a color. C C If less than 16 color indices are available, PGGRAY uses only C color index 1, and uses a "dithering" algorithm to fill in pixels, C with the shade (computed as above) determining the faction of pixels C that are filled. In this mode the shaded region is "transparent" and C allows previously-drawn graphics to show through. C C The transformation matrix TR is used to calculate the world C coordinates of the center of the "cell" that represents each C array element. The world coordinates of the center of the cell C corresponding to array element A(I,J) are given by: C C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C C Usually TR(3) and TR(5) are zero -- unless the coordinate C transformation involves a rotation or shear. The corners of the C quadrilateral region that is shaded by PGGRAY are given by C applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5). C C Arguments: C A (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C FG (input) : the array value which is to appear with the C foreground color (corresponding to color index 1). C BG (input) : the array value which is to appear with the C background color (corresponding to color index 0). C TR (input) : transformation matrix between array grid and C world coordinates. C-- C 2-Sep-1987: remove device-dependent code to routine GRGRAY (TJP). C 7-Jun-1988: change documentation and argument names (TJP). C 31-May-1989: allow 1-pixel wide arrays to be plotted (TJP). C 17-Mar-1994: pass PG scaling info to lower routines (TJP). C 15-Sep-1994: use PGITF attribute (TJP). C 8-Feb-1995: use color ramp based on current foreground and background C colors (TJP). C 6-May-1996: allow multiple devives (TJP). C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL PA(6) LOGICAL PGNOTO C C Check inputs. C IF (PGNOTO('PGGRAY')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN CALL GRWARN('PGGRAY: invalid range I1:I2, J1:J2') ELSE IF (FG.EQ.BG) THEN CALL GRWARN('PGGRAY: foreground level = background level') ELSE C C Call lower-level routine to do the work. C CALL PGBBUF CALL PGSAVE CALL PGSCI(1) PA(1) = TR(1)*PGXSCL(PGID) + PGXORG(PGID) PA(2) = TR(2)*PGXSCL(PGID) PA(3) = TR(3)*PGXSCL(PGID) PA(4) = TR(4)*PGYSCL(PGID) + PGYORG(PGID) PA(5) = TR(5)*PGYSCL(PGID) PA(6) = TR(6)*PGYSCL(PGID) CALL GRGRAY(A, IDIM, JDIM, I1, I2, J1, J2, FG, BG, PA, : PGMNCI(PGID), PGMXCI(PGID), PGITF(PGID)) CALL PGEBUF CALL PGUNSA END IF C----------------------------------------------------------------------- END pgplot/src/pghi2d.f010064400040640000322000000127130613406371300146540ustar00tjpcitmbr00000400000017C*PGHI2D -- cross-sections through a 2D data array C%void cpghi2d(const float *data, int nxv, int nyv, int ix1, \ C% int ix2, int iy1, int iy2, const float *x, int ioff, float bias, \ C% Logical center, float *ylims); C+ SUBROUTINE PGHI2D (DATA, NXV, NYV, IX1, IX2, IY1, IY2, X, IOFF, 1 BIAS, CENTER, YLIMS) INTEGER NXV, NYV, IX1, IX2, IY1, IY2 REAL DATA(NXV,NYV) REAL X(IX2-IX1+1), YLIMS(IX2-IX1+1) INTEGER IOFF REAL BIAS LOGICAL CENTER C C Plot a series of cross-sections through a 2D data array. C Each cross-section is plotted as a hidden line histogram. The plot C can be slanted to give a pseudo-3D effect - if this is done, the C call to PGENV may have to be changed to allow for the increased X C range that will be needed. C C Arguments: C DATA (input) : the data array to be plotted. C NXV (input) : the first dimension of DATA. C NYV (input) : the second dimension of DATA. C IX1 (input) C IX2 (input) C IY1 (input) C IY2 (input) : PGHI2D plots a subset of the input array DATA. C This subset is delimited in the first (x) C dimension by IX1 and IX2 and the 2nd (y) by IY1 C and IY2, inclusively. Note: IY2 < IY1 is C permitted, resulting in a plot with the C cross-sections plotted in reverse Y order. C However, IX2 must be => IX1. C X (input) : the abscissae of the bins to be plotted. That is, C X(1) should be the X value for DATA(IX1,IY1), and C X should have (IX2-IX1+1) elements. The program C has to assume that the X value for DATA(x,y) is C the same for all y. C IOFF (input) : an offset in array elements applied to successive C cross-sections to produce a slanted effect. A C plot with IOFF > 0 slants to the right, one with C IOFF < 0 slants left. C BIAS (input) : a bias value applied to each successive cross- C section in order to raise it above the previous C cross-section. This is in the same units as the C data. C CENTER (input) : if .true., the X values denote the center of the C bins; if .false. the X values denote the lower C edges (in X) of the bins. C YLIMS (input) : workspace. Should be an array of at least C (IX2-IX1+1) elements. C-- C 21-Feb-1984 - Keith Shortridge. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL FIRST,PENDOW,HPLOT,VPLOT INTEGER IY,INC,IX,NELMX,IXPT,NOFF REAL CBIAS,YNWAS,XNWAS,YN,XN,VTO,VFROM,YLIMWS,YLIM REAL PGHIS1 LOGICAL PGNOTO C C Check arguments. C IF (IX1.GT.IX2) RETURN IF (PGNOTO('PGHI2D')) RETURN CALL PGBBUF C C Check Y order. C IF (IY1.GT.IY2) THEN INC = -1 ELSE INC = 1 END IF C C Clear limits array. C NELMX = IX2 - IX1 + 1 DO 10 IX=1,NELMX YLIMS(IX) = PGYBLC(PGID) 10 CONTINUE C C Loop through Y values. C NOFF = 0 CBIAS = 0. DO 200 IY=IY1,IY2,INC YNWAS = CBIAS YLIMWS = YNWAS XNWAS = PGHIS1(X,NELMX,CENTER,1+NOFF) PENDOW = .FALSE. FIRST = .TRUE. IXPT = 1 C C Draw histogram for this Y value. C DO 100 IX=IX1,IX2 YN = DATA(IX,IY) + CBIAS XN = PGHIS1(X,NELMX,CENTER,IXPT+NOFF+1) YLIM = YLIMS(IXPT) C C Given X and Y old and new values, and limits, see which parts of the C lines are to be drawn. C IF (YN.GT.YLIM) THEN YLIMS(IXPT) = YN HPLOT = .TRUE. VPLOT = .TRUE. VTO = YN VFROM = YLIM IF (YNWAS.GT.YLIMWS) VFROM = YNWAS ELSE HPLOT = .FALSE. IF (YNWAS.GT.YLIMWS) THEN VPLOT = .TRUE. VFROM = YNWAS VTO = YLIM ELSE VPLOT = .FALSE. END IF END IF C C Plot the bin. C IF (VPLOT) THEN IF (.NOT.PENDOW) THEN IF (FIRST) THEN CALL GRMOVA(XNWAS,MAX(VTO,CBIAS)) FIRST = .FALSE. ELSE CALL GRMOVA(XNWAS,VFROM) END IF END IF CALL GRLINA(XNWAS,VTO) IF (HPLOT) THEN CALL GRLINA(XN,YN) END IF END IF PENDOW = HPLOT YLIMWS = YLIM YNWAS = YN XNWAS = XN IXPT = IXPT + 1 100 CONTINUE IF (PENDOW) CALL GRLINA(XN,MAX(YLIM,CBIAS)) C C If any offset in operation, shift limits array to compensate for it. C IF (IOFF.GT.0) THEN DO 110 IX=1,NELMX-IOFF YLIMS(IX) = YLIMS(IX+IOFF) 110 CONTINUE DO 120 IX=NELMX-IOFF+1,NELMX YLIMS(IX) = PGYBLC(PGID) 120 CONTINUE ELSE IF (IOFF.LT.0) THEN DO 130 IX=NELMX,1-IOFF,-1 YLIMS(IX) = YLIMS(IX+IOFF) 130 CONTINUE DO 140 IX=1,-IOFF YLIMS(IX) = PGYBLC(PGID) 140 CONTINUE END IF CBIAS = CBIAS + BIAS NOFF = NOFF + IOFF 200 CONTINUE C CALL PGEBUF END pgplot/src/pgmtxt.f010064400040640000322000000107300613406371700150230ustar00tjpcitmbr00000400000017C*PGMTXT -- write text at position relative to viewport C%void cpgmtxt(const char *side, float disp, float coord, \ C% float fjust, const char *text); C+ SUBROUTINE PGMTXT (SIDE, DISP, COORD, FJUST, TEXT) CHARACTER*(*) SIDE, TEXT REAL DISP, COORD, FJUST C C Write text at a position specified relative to the viewport (outside C or inside). This routine is useful for annotating graphs. It is used C by routine PGLAB. The text is written using the current values of C attributes color-index, line-width, character-height, and C character-font. C C Arguments: C SIDE (input) : must include one of the characters 'B', 'L', 'T', C or 'R' signifying the Bottom, Left, Top, or Right C margin of the viewport. If it includes 'LV' or C 'RV', the string is written perpendicular to the C frame rather than parallel to it. C DISP (input) : the displacement of the character string from the C specified edge of the viewport, measured outwards C from the viewport in units of the character C height. Use a negative value to write inside the C viewport, a positive value to write outside. C COORD (input) : the location of the character string along the C specified edge of the viewport, as a fraction of C the length of the edge. C FJUST (input) : controls justification of the string parallel to C the specified edge of the viewport. If C FJUST = 0.0, the left-hand end of the string will C be placed at COORD; if JUST = 0.5, the center of C the string will be placed at COORD; if JUST = 1.0, C the right-hand end of the string will be placed at C at COORD. Other values between 0 and 1 give inter- C mediate placing, but they are not very useful. C TEXT (input) : the text string to be plotted. Trailing spaces are C ignored when justifying the string, but leading C spaces are significant. C C-- C 18-Apr-1983 C 15-Aug-1987 - fix BBUF/EBUF error. C 27-Aug-1987 - fix justification error if XPERIN.ne.YPERIN. C 05-Sep-1989 - change so that DISP has some effect for 'RV' and C 'LV' options [nebk] C 16-Oct-1993 - erase background of opaque text. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL ANGLE, D, X, Y, RATIO, XBOX(4), YBOX(4) INTEGER CI, I, L, GRTRIM CHARACTER*20 TEST C IF (PGNOTO('PGMTXT')) RETURN C L = GRTRIM(TEXT) IF (L.LT.1) RETURN D = 0.0 IF (FJUST.NE.0.0) CALL GRLEN(TEXT(1:L),D) D = D*FJUST RATIO = PGYPIN(PGID)/PGXPIN(PGID) CALL GRTOUP(TEST,SIDE) IF (INDEX(TEST,'B').NE.0) THEN ANGLE = 0.0 X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D Y = PGYOFF(PGID) - PGYSP(PGID)*DISP ELSE IF (INDEX(TEST,'LV').NE.0) THEN ANGLE = 0.0 X = PGXOFF(PGID) - PGYSP(PGID)*DISP - D Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID) ELSE IF (INDEX(TEST,'L').NE.0) THEN ANGLE = 90.0 X = PGXOFF(PGID) - PGYSP(PGID)*DISP Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO ELSE IF (INDEX(TEST,'T').NE.0) THEN ANGLE = 0.0 X = PGXOFF(PGID) + COORD*PGXLEN(PGID) - D Y = PGYOFF(PGID) + PGYLEN(PGID) + PGYSP(PGID)*DISP ELSE IF (INDEX(TEST,'RV').NE.0) THEN ANGLE = 0.0 X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP - D Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - 0.3*PGYSP(PGID) ELSE IF (INDEX(TEST,'R').NE.0) THEN ANGLE = 90.0 X = PGXOFF(PGID) + PGXLEN(PGID) + PGYSP(PGID)*DISP Y = PGYOFF(PGID) + COORD*PGYLEN(PGID) - D*RATIO ELSE CALL GRWARN('Invalid "SIDE" argument in PGMTXT.') RETURN END IF CALL PGBBUF IF (PGTBCI(PGID).GE.0) THEN CALL GRQTXT (ANGLE, X, Y, TEXT(1:L), XBOX, YBOX) DO 25 I=1,4 XBOX(I) = (XBOX(I)-PGXORG(PGID))/PGXSCL(PGID) YBOX(I) = (YBOX(I)-PGYORG(PGID))/PGYSCL(PGID) 25 CONTINUE CALL PGQCI(CI) CALL PGSCI(PGTBCI(PGID)) CALL GRFA(4, XBOX, YBOX) CALL PGSCI(CI) END IF CALL GRTEXT(.FALSE.,ANGLE,.TRUE., X, Y, TEXT(1:L)) CALL PGEBUF END pgplot/src/pgqfs.f010064400040640000322000000013420606640061000146060ustar00tjpcitmbr00000400000017C*PGQFS -- inquire fill-area style C%void cpgqfs(int *fs); C+ SUBROUTINE PGQFS (FS) INTEGER FS C C Query the current Fill-Area Style attribute (set by routine C PGSFS). C C Argument: C FS (output) : the current fill-area style: C FS = 1 => solid (default) C FS = 2 => outline C FS = 3 => hatched C FS = 4 => cross-hatched C-- C 5-Nov-1985 - new routine [TJP]. C 6-Mar-1995 - add styles 3 and 4 [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGQFS')) THEN FS = 1 ELSE FS = PGFAS(PGID) END IF END pgplot/src/pgqvp.f010064400040640000322000000037310606640061200146310ustar00tjpcitmbr00000400000017C*PGQVP -- inquire viewport size and position C%void cpgqvp(int units, float *x1, float *x2, float *y1, float *y2); C+ SUBROUTINE PGQVP (UNITS, X1, X2, Y1, Y2) INTEGER UNITS REAL X1, X2, Y1, Y2 C C Inquiry routine to determine the current viewport setting. C The values returned may be normalized device coordinates, inches, mm, C or pixels, depending on the value of the input parameter CFLAG. C C Arguments: C UNITS (input) : used to specify the units of the output parameters: C UNITS = 0 : normalized device coordinates C UNITS = 1 : inches C UNITS = 2 : millimeters C UNITS = 3 : pixels C Other values give an error message, and are C treated as 0. C X1 (output) : the x-coordinate of the bottom left corner of the C viewport. C X2 (output) : the x-coordinate of the top right corner of the C viewport. C Y1 (output) : the y-coordinate of the bottom left corner of the C viewport. C Y2 (output) : the y-coordinate of the top right corner of the C viewport. C-- C 26-Sep-1985 - new routine (TJP). C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL SX, SY C IF (UNITS.EQ.0) THEN SX = PGXSZ(PGID) SY = PGYSZ(PGID) ELSE IF (UNITS.EQ.1) THEN SX = PGXPIN(PGID) SY = PGYPIN(PGID) ELSE IF (UNITS.EQ.2) THEN SX = (PGXPIN(PGID)/25.4) SY = (PGYPIN(PGID)/25.4) ELSE IF (UNITS.EQ.3) THEN SX = 1.0 SY = 1.0 ELSE CALL GRWARN( 1 'Illegal value for parameter UNITS in routine PGQVP') SX = PGXSZ(PGID) SY = PGYSZ(PGID) END IF X1 = PGXVP(PGID)/SX X2 = (PGXVP(PGID)+PGXLEN(PGID))/SX Y1 = PGYVP(PGID)/SY Y2 = (PGYVP(PGID)+PGYLEN(PGID))/SY END pgplot/src/pgnoto.f010064400040640000322000000016500613231360200147740ustar00tjpcitmbr00000400000017C LOGICAL FUNCTION PGNOTO (RTN) CHARACTER*(*) RTN C C PGPLOT (internal routine): Test whether a PGPLOT device is open and C print a message if not. Usage: C LOGICAL PGNOTO C IF (PGNOTO('routine')) RETURN C C Arguments: C C RTN (input, character): routine name to be include in message. C C Returns: C .TRUE. if PGPLOT is not open. C-- C 11-Nov-1994 C 21-Dec-1995 - revised for multiple devices. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*80 TEXT C CALL PGINIT PGNOTO = .FALSE. IF (PGID.LT.1 .OR. PGID.GT.PGMAXD) THEN PGNOTO = .TRUE. TEXT = RTN//': no graphics device has been selected' CALL GRWARN(TEXT) ELSE IF (PGDEVS(PGID).NE.1) THEN PGNOTO = .TRUE. TEXT = RTN//': selected graphics device is not open' CALL GRWARN(TEXT) END IF RETURN END pgplot/src/pgpanl.f010064400040640000322000000031300606640060300147460ustar00tjpcitmbr00000400000017C*PGPANL -- switch to a different panel on the view surface C%void cpgpanl(int nxc, int nyc); C+ SUBROUTINE PGPANL(IX, IY) INTEGER IX, IY C C Start plotting in a different panel. If the view surface has been C divided into panels by PGBEG or PGSUBP, this routine can be used to C move to a different panel. Note that PGPLOT does not remember what C viewport and window were in use in each panel; these should be reset C if necessary after calling PGPANL. Nor does PGPLOT clear the panel: C call PGERAS after calling PGPANL to do this. C C Arguments: C IX (input) : the horizontal index of the panel (in the range C 1 <= IX <= number of panels in horizontal C direction). C IY (input) : the vertical index of the panel (in the range C 1 <= IY <= number of panels in horizontal C direction). C-- C 1-Dec-1994 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C C Check that a device is open. C IF (PGNOTO('PGPANL')) RETURN C C Check arguments. C IF (IX.LT.1 .OR. IX.GT.PGNX(PGID) .OR. : IY.LT.1 .OR. IY.GT.PGNY(PGID)) THEN CALL GRWARN('PGPANL: the requested panel does not exist') C C Adjust the viewport to the new panel and window the plot C in the new viewport. C ELSE PGNXC(PGID) = IX PGNYC(PGID) = IY PGXOFF(PGID) = PGXVP(PGID) + (IX-1)*PGXSZ(PGID) PGYOFF(PGID) = PGYVP(PGID) + (PGNY(PGID)-IY)*PGYSZ(PGID) CALL PGVW END IF C END pgplot/src/pgvstd.f010064400040640000322000000015520606640062600150070ustar00tjpcitmbr00000400000017C*PGVSTD -- set standard (default) viewport C%void cpgvstd(void); C+ SUBROUTINE PGVSTD C C Define the viewport to be the standard viewport. The standard C viewport is the full area of the view surface (or panel), C less a margin of 4 character heights all round for labelling. C It thus depends on the current character size, set by PGSCH. C C Arguments: none. C-- C 22-Apr-1983: [TJP]. C 2-Aug-1995: [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL XLEFT, XRIGHT, YBOT, YTOP, R C IF (PGNOTO('PGVSIZ')) RETURN C R = 4.0*PGYSP(PGID) XLEFT = R/PGXPIN(PGID) XRIGHT = XLEFT + (PGXSZ(PGID)-2.0*R)/PGXPIN(PGID) YBOT = R/PGYPIN(PGID) YTOP = YBOT + (PGYSZ(PGID)-2.0*R)/PGYPIN(PGID) CALL PGVSIZ(XLEFT, XRIGHT, YBOT, YTOP) END pgplot/src/pgimag.f010064400040640000322000000104310613406371400147370ustar00tjpcitmbr00000400000017C*PGIMAG -- color image from a 2D data array C%void cpgimag(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float a1, float a2, const float *tr); C+ SUBROUTINE PGIMAG (A, IDIM, JDIM, I1, I2, J1, J2, 1 A1, A2, TR) INTEGER IDIM, JDIM, I1, I2, J1, J2 REAL A(IDIM,JDIM), A1, A2, TR(6) C C Draw a color image of an array in current window. The subsection C of the array A defined by indices (I1:I2, J1:J2) is mapped onto C the view surface world-coordinate system by the transformation C matrix TR. The resulting quadrilateral region is clipped at the edge C of the window. Each element of the array is represented in the image C by a small quadrilateral, which is filled with a color specified by C the corresponding array value. C C The subroutine uses color indices in the range C1 to C2, which can C be specified by calling PGSCIR before PGIMAG. The default values C for C1 and C2 are device-dependent; these values can be determined by C calling PGQCIR. Note that color representations should be assigned to C color indices C1 to C2 by calling PGSCR before calling PGIMAG. On some C devices (but not all), the color representation can be changed after C the call to PGIMAG by calling PGSCR again. C C Array values in the range A1 to A2 are mapped on to the range of C color indices C1 to C2, with array values <= A1 being given color C index C1 and values >= A2 being given color index C2. The mapping C function for intermediate array values can be specified by C calling routine PGSITF before PGIMAG; the default is linear. C C On devices which have no available color indices (C1 > C2), C PGIMAG will return without doing anything. On devices with only C one color index (C1=C2), all array values map to the same color C which is rather uninteresting. An image is always "opaque", C i.e., it obscures all graphical elements previously drawn in C the region. C C The transformation matrix TR is used to calculate the world C coordinates of the center of the "cell" that represents each C array element. The world coordinates of the center of the cell C corresponding to array element A(I,J) are given by: C C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C C Usually TR(3) and TR(5) are zero -- unless the coordinate C transformation involves a rotation or shear. The corners of the C quadrilateral region that is shaded by PGIMAG are given by C applying this transformation to (I1-0.5,J1-0.5), (I2+0.5, J2+0.5). C C Arguments: C A (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C A1 (input) : the array value which is to appear with shade C1. C A2 (input) : the array value which is to appear with shade C2. C TR (input) : transformation matrix between array grid and C world coordinates. C-- C 15-Sep-1994: new routine [TJP]. C 21-Jun-1995: minor change to header comments [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL PA(6) LOGICAL PGNOTO C C Check inputs. C IF (PGNOTO('PGIMAG')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN CALL GRWARN('PGIMAG: invalid range I1:I2, J1:J2') ELSE IF (A1.EQ.A2) THEN CALL GRWARN('PGIMAG: foreground level = background level') ELSE IF (PGMNCI(PGID).GT.PGMXCI(PGID)) THEN CALL GRWARN('PGIMAG: not enough colors available') ELSE C C Call lower-level routine to do the work. C CALL PGBBUF PA(1) = TR(1)*PGXSCL(PGID) + PGXORG(PGID) PA(2) = TR(2)*PGXSCL(PGID) PA(3) = TR(3)*PGXSCL(PGID) PA(4) = TR(4)*PGYSCL(PGID) + PGYORG(PGID) PA(5) = TR(5)*PGYSCL(PGID) PA(6) = TR(6)*PGYSCL(PGID) CALL GRIMG0(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA, : PGMNCI(PGID), PGMXCI(PGID), PGITF(PGID)) CALL PGEBUF END IF C----------------------------------------------------------------------- END pgplot/src/pgline.f010064400040640000322000000025020631361205000147410ustar00tjpcitmbr00000400000017C*PGLINE -- draw a polyline (curve defined by line-segments) C%void cpgline(int n, const float *xpts, const float *ypts); C+ SUBROUTINE PGLINE (N, XPTS, YPTS) INTEGER N REAL XPTS(*), YPTS(*) C C Primitive routine to draw a Polyline. A polyline is one or more C connected straight-line segments. The polyline is drawn using C the current setting of attributes color-index, line-style, and C line-width. The polyline is clipped at the edge of the window. C C Arguments: C N (input) : number of points defining the line; the line C consists of (N-1) straight-line segments. C N should be greater than 1 (if it is 1 or less, C nothing will be drawn). C XPTS (input) : world x-coordinates of the points. C YPTS (input) : world y-coordinates of the points. C C The dimension of arrays X and Y must be greater than or equal to N. C The "pen position" is changed to (X(N),Y(N)) in world coordinates C (if N > 1). C-- C 27-Nov-1986 C----------------------------------------------------------------------- INTEGER I LOGICAL PGNOTO C IF (PGNOTO('PGLINE')) RETURN IF (N.LT.2) RETURN C CALL PGBBUF CALL GRMOVA(XPTS(1),YPTS(1)) DO 10 I=2,N CALL GRLINA(XPTS(I),YPTS(I)) 10 CONTINUE CALL PGEBUF END pgplot/src/pgqwin.f010064400040640000322000000016560606640061300150060ustar00tjpcitmbr00000400000017C*PGQWIN -- inquire window boundary coordinates C%void cpgqwin(float *x1, float *x2, float *y1, float *y2); C+ SUBROUTINE PGQWIN (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C Inquiry routine to determine the current window setting. C The values returned are world coordinates. C C Arguments: C X1 (output) : the x-coordinate of the bottom left corner C of the window. C X2 (output) : the x-coordinate of the top right corner C of the window. C Y1 (output) : the y-coordinate of the bottom left corner C of the window. C Y2 (output) : the y-coordinate of the top right corner C of the window. C-- C 26-Sep-1985 - new routine (TJP). C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C X1 = PGXBLC(PGID) X2 = PGXTRC(PGID) Y1 = PGYBLC(PGID) Y2 = PGYTRC(PGID) END pgplot/src/pgaxlg.f010064400040640000322000000124750631605562200147700ustar00tjpcitmbr00000400000017C PGAXLG -- draw a logarithmic axis [internal routine] C SUBROUTINE PGAXLG (OPT, X1, Y1, X2, Y2, V1, V2, STEP, : DMAJL, DMAJR, FMIN, DISP, ORIENT) CHARACTER*(*) OPT REAL X1, Y1, X2, Y2, V1, V2, STEP REAL DMAJL, DMAJR, FMIN, DISP, ORIENT C C Draw a labelled graph axis from world-coordinate position (X1,Y1) C to (X2,Y2). The quantity described by the axis runs from 10**V1 to C 10**V2. A logarithmic axis always has major, labeled, tick marks C spaced by one or more decades. If the major tick marks are spaced C by one decade (as specified by the STEP argument), then minor C tick marks are placed at 2, 3, .., 9 times each power of 10; C otherwise minor tick marks are spaced by one decade. If the axis C spans less than two decades, numeric labels are placed at 1, 2, and C 5 times each power of ten. C C It is not advisable to use this routine if the axis spans less than C one decade, or if it spans many decades. In these cases it is C preferable to use a linear axis labeled with the logarithm of the C quantity of interest. C C Arguments: C OPT (input) : a string containing single-letter codes for C various options. The options currently C recognized are: C N : write numeric labels C 1 : force decimal labelling, instead of automatic C choice (see PGNUMB). C 2 : force exponential labelling, instead of C automatic. C X1, Y1 (input) : world coordinates of one endpoint of the axis. C X2, Y2 (input) : world coordinates of the other endpoint of the axis. C V1 (input) : logarithm of axis value at first endpoint. C V2 (input) : logarithm of axis value at second endpoint. C STEP (input) : the number of decades between major (labeled) tick C marks. C DMAJL (input) : length of major tick marks drawn to left of axis C (as seen looking from first endpoint to second), in C units of the character height. C DMAJR (input) : length of major tick marks drawn to right of axis, C in units of the character height. C FMIN (input) : length of minor tick marks, as fraction of major. C DISP (input) : displacement of baseline of tick labels to C right of axis, in units of the character height. C ORIENT (input) : orientation of text label relative to axis (see C PGTICK). C-- C 25-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- REAL V, VMIN, VMAX, DVMAJ, DVMIN, PGRND INTEGER I, K, K1, K2, LLAB, NSUBT, CLIP, FORM LOGICAL XLAB, OPTN CHARACTER*32 LABEL REAL TAB(9) C C Table of logarithms 1..9 C DATA TAB / 0.00000, 0.30103, 0.47712, 0.60206, 0.69897, : 0.77815, 0.84510, 0.90309, 0.95424 / C C Check arguments. C IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN IF (V1.EQ.V2) RETURN C C Decode options. C OPTN = INDEX(OPT,'N').NE.0 .OR. INDEX(OPT,'n').NE.0 FORM =0 IF (INDEX(OPT,'1').NE.0) FORM = 1 IF (INDEX(OPT,'2').NE.0) FORM = 2 C C Choose major interval (DVMAJ in the logarithm, with minimum value C 1.0 = one decade). The minor interval is always 1.0. C IF (STEP.GT.0.5) THEN DVMAJ = NINT(STEP) ELSE DVMAJ = PGRND(0.20*ABS(V1-V2),NSUBT) IF (DVMAJ.LT.1.0) DVMAJ = 1.0 END IF DVMIN = 1.0 NSUBT = DVMAJ/DVMIN C CALL PGBBUF CALL PGQCLP(CLIP) CALL PGSCLP(0) C C Draw the axis. C CALL PGMOVE(X1, Y1) CALL PGDRAW(X2, Y2) C C Draw the tick marks. Major ticks are drawn at V = K*DVMAJ. C VMIN = MIN(V1, V2) VMAX = MAX(V1, V2) K1 = INT(VMIN/DVMIN) IF (DVMIN*K1.LT.VMIN) K1 = K1+1 K2 = INT(VMAX/DVMIN) IF (DVMIN*K2.GT.VMAX) K2 = K2-1 XLAB = (K2-K1) .LE. 2 DO 20 K=K1,K2 V = (K*DVMIN-V1)/(V2-V1) IF (MOD(K,NSUBT).EQ.0) THEN C -- major tick mark IF (OPTN) THEN CALL PGNUMB(1, NINT(K*DVMIN), FORM, LABEL, LLAB) ELSE LABEL = ' ' LLAB = 1 END IF CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL, DMAJR, : DISP, ORIENT, LABEL(:LLAB)) ELSE C -- minor tick mark CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN, : 0.0, ORIENT, ' ') END IF 20 CONTINUE C C Draw intermediate tick marks if required. C Label them if axis spans less than 2 decades. C IF (NSUBT.EQ.1) THEN DO 30 K=K1-1,K2+1 DO 25 I=2,9 V = (K*DVMIN + TAB(I) -V1)/(V2-V1) IF (V.GE.0.0 .AND. V.LE.1.0) THEN IF (OPTN.AND.(XLAB .AND.(I.EQ.2 .OR. I.EQ.5))) THEN C -- labeled minor tick mark CALL PGNUMB(I, NINT(K*DVMIN), FORM, LABEL, LLAB) ELSE C -- unlabeled minor tick mark LABEL = ' ' LLAB = 1 END IF CALL PGTICK(X1, Y1, X2, Y2, V, DMAJL*FMIN, DMAJR*FMIN, : DISP, ORIENT, LABEL(:LLAB)) END IF 25 CONTINUE 30 CONTINUE END IF C CALL PGSCLP(CLIP) CALL PGEBUF END pgplot/src/pgsvp.f010064400040640000322000000033560606640062300146400ustar00tjpcitmbr00000400000017C*PGSVP -- set viewport (normalized device coordinates) C%void cpgsvp(float xleft, float xright, float ybot, float ytop); C+ SUBROUTINE PGSVP (XLEFT, XRIGHT, YBOT, YTOP) REAL XLEFT, XRIGHT, YBOT, YTOP C C Change the size and position of the viewport, specifying C the viewport in normalized device coordinates. Normalized C device coordinates run from 0 to 1 in each dimension. The C viewport is the rectangle on the view surface "through" C which one views the graph. All the PG routines which plot lines C etc. plot them within the viewport, and lines are truncated at C the edge of the viewport (except for axes, labels etc drawn with C PGBOX or PGLAB). The region of world space (the coordinate C space of the graph) which is visible through the viewport is C specified by a call to PGSWIN. It is legal to request a C viewport larger than the view surface; only the part which C appears on the view surface will be plotted. C C Arguments: C XLEFT (input) : x-coordinate of left hand edge of viewport, in NDC. C XRIGHT (input) : x-coordinate of right hand edge of viewport, C in NDC. C YBOT (input) : y-coordinate of bottom edge of viewport, in NDC. C YTOP (input) : y-coordinate of top edge of viewport, in NDC. C-- C 13-Dec-1990 Make errors non-fatal [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL XS, YS C IF (PGNOTO('PGSVP')) RETURN IF (XLEFT.GE.XRIGHT .OR. YBOT.GE.YTOP) THEN CALL GRWARN('PGSVP ignored: invalid arguments') RETURN END IF C XS = PGXSZ(PGID)/PGXPIN(PGID) YS = PGYSZ(PGID)/PGYPIN(PGID) CALL PGVSIZ(XLEFT*XS, XRIGHT*XS, YBOT*YS, YTOP*YS) END pgplot/src/pgswin.f010064400040640000322000000026660606640062400150140ustar00tjpcitmbr00000400000017C*PGSWIN -- set window C%void cpgswin(float x1, float x2, float y1, float y2); C+ SUBROUTINE PGSWIN (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C Change the window in world coordinate space that is to be mapped on C to the viewport. Usually PGSWIN is called automatically by PGENV, C but it may be called directly by the user. C C Arguments: C X1 (input) : the x-coordinate of the bottom left corner C of the viewport. C X2 (input) : the x-coordinate of the top right corner C of the viewport (note X2 may be less than X1). C Y1 (input) : the y-coordinate of the bottom left corner C of the viewport. C Y2 (input) : the y-coordinate of the top right corner C of the viewport (note Y2 may be less than Y1). C-- C 15-Nov-95: check arguments to prevent divide-by-zero [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSWIN')) RETURN C C If invalid arguments are specified, issue warning and leave window C unchanged. C IF (X1.EQ.X2) THEN CALL GRWARN('invalid x limits in PGSWIN: X1 = X2.') ELSE IF (Y1.EQ.Y2) THEN CALL GRWARN('invalid y limits in PGSWIN: Y1 = Y2.') ELSE PGXBLC(PGID) = X1 PGXTRC(PGID) = X2 PGYBLC(PGID) = Y1 PGYTRC(PGID) = Y2 CALL PGVW END IF END pgplot/src/pgbox.f010064400040640000322000000412270631362404200146150ustar00tjpcitmbr00000400000017C*PGBOX -- draw labeled frame around viewport C%void cpgbox(const char *xopt, float xtick, int nxsub, \ C% const char *yopt, float ytick, int nysub); C+ SUBROUTINE PGBOX (XOPT, XTICK, NXSUB, YOPT, YTICK, NYSUB) CHARACTER*(*) XOPT, YOPT REAL XTICK, YTICK INTEGER NXSUB, NYSUB C C Annotate the viewport with frame, axes, numeric labels, etc. C PGBOX is called by on the user's behalf by PGENV, but may also be C called explicitly. C C Arguments: C XOPT (input) : string of options for X (horizontal) axis of C plot. Options are single letters, and may be in C any order (see below). C XTICK (input) : world coordinate interval between major tick marks C on X axis. If XTICK=0.0, the interval is chosen by C PGBOX, so that there will be at least 3 major tick C marks along the axis. C NXSUB (input) : the number of subintervals to divide the major C coordinate interval into. If XTICK=0.0 or NXSUB=0, C the number is chosen by PGBOX. C YOPT (input) : string of options for Y (vertical) axis of plot. C Coding is the same as for XOPT. C YTICK (input) : like XTICK for the Y axis. C NYSUB (input) : like NXSUB for the Y axis. C C Options (for parameters XOPT and YOPT): C A : draw Axis (X axis is horizontal line Y=0, Y axis is vertical C line X=0). C B : draw bottom (X) or left (Y) edge of frame. C C : draw top (X) or right (Y) edge of frame. C G : draw Grid of vertical (X) or horizontal (Y) lines. C I : Invert the tick marks; ie draw them outside the viewport C instead of inside. C L : label axis Logarithmically (see below). C N : write Numeric labels in the conventional location below the C viewport (X) or to the left of the viewport (Y). C P : extend ("Project") major tick marks outside the box (ignored if C option I is specified). C M : write numeric labels in the unconventional location above the C viewport (X) or to the right of the viewport (Y). C T : draw major Tick marks at the major coordinate interval. C S : draw minor tick marks (Subticks). C V : orient numeric labels Vertically. This is only applicable to Y. C The default is to write Y-labels parallel to the axis. C 1 : force decimal labelling, instead of automatic choice (see PGNUMB). C 2 : force exponential labelling, instead of automatic. C C To get a complete frame, specify BC in both XOPT and YOPT. C Tick marks, if requested, are drawn on the axes or frame C or both, depending which are requested. If none of ABC is specified, C tick marks will not be drawn. When PGENV calls PGBOX, it sets both C XOPT and YOPT according to the value of its parameter AXIS: C -1: 'BC', 0: 'BCNST', 1: 'ABCNST', 2: 'ABCGNST'. C C For a logarithmic axis, the major tick interval is always 1.0. The C numeric label is 10**(x) where x is the world coordinate at the C tick mark. If subticks are requested, 8 subticks are drawn between C each major tick at equal logarithmic intervals. C C To label an axis with time (days, hours, minutes, seconds) or C angle (degrees, arcmin, arcsec), use routine PGTBOX. C-- C 19-Oct-1983 C 23-Sep-1984 - fix bug in labelling reversed logarithmic axes. C 6-May-1985 - improve behavior for pen plotters [TJP]. C 23-Nov-1985 - add 'P' option [TJP]. C 14-Jan-1986 - use new routine PGBOX1 to fix problem of missing C labels at end of axis [TJP]. C 8-Apr-1987 - improve automatic choice of tick interval; improve C erroneous rounding of tick interval to 1 digit [TJP]. C 23-Apr-1987 - fix bug: limit max number of ticks to ~10 [TJP]. C 7-Nov-1987 - yet another change to algorithm for choosing tick C interval; maximum tick interval is now 0.2*range of C axis, which may round up to 0.5 [TJP]. C 15-Dec-1988 - correct declaration of MAJOR [TJP]. C 6-Sep-1989 - use Fortran generic intrinsic functions [TJP]. C 18-Oct-1990 - correctly initialize UTAB(1) [AFT]. C 19-Oct-1990 - do all plotting in world coordinates [TJP]. C 6-Nov-1991 - label logarithmic subticks when necessary [TJP]. C 4-Jul-1994 - add '1' and '2' options [TJP]. C 20-Apr-1995 - adjust position of labels slightly, and move out C when ticks are inverted [TJP]. C 26-Feb-1997 - use new routine pgclp [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*20 CLBL CHARACTER*64 OPT LOGICAL XOPTA, XOPTB, XOPTC, XOPTG, XOPTN, XOPTM, XOPTT, XOPTS LOGICAL YOPTA, YOPTB, YOPTC, YOPTG, YOPTN, YOPTM, YOPTT, YOPTS LOGICAL XOPTI, YOPTI, YOPTV, XOPTL, YOPTL, XOPTP, YOPTP, RANGE LOGICAL IRANGE, MAJOR, XOPTLS, YOPTLS, PGNOTO REAL TAB(9), UTAB(9) INTEGER I, I1, I2, J, NC, NP, NV, KI, CLIP INTEGER NSUBX, NSUBY, JMAX, XNFORM, YNFORM REAL TIKL, TIKL1, TIKL2, XC, YC REAL XINT, XINT2, XVAL, YINT, YINT2, YVAL REAL PGRND REAL A, B, C REAL XNDSP, XMDSP, YNDSP, YMDSP, YNVDSP, YMVDSP REAL XBLC, XTRC, YBLC, YTRC INTRINSIC ABS, INDEX, INT, LOG10, MAX, MIN, MOD, NINT, SIGN, REAL C C Table of logarithms 1..9 C DATA TAB / 0.00000, 0.30103, 0.47712, 0.60206, 0.69897, 1 0.77815, 0.84510, 0.90309, 0.95424 / C RANGE(A,B,C) = (A.LT.B.AND.B.LT.C) .OR. (C.LT.B.AND.B.LT.A) IRANGE(A,B,C) = (A.LE.B.AND.B.LE.C) .OR. (C.LE.B.AND.B.LE.A) C IF (PGNOTO('PGBOX')) RETURN CALL PGBBUF CALL PGQWIN(XBLC, XTRC, YBLC, YTRC) C C Decode options. C CALL GRTOUP(OPT,XOPT) XOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(YBLC,0.0,YTRC) XOPTB = INDEX(OPT,'B').NE.0 XOPTC = INDEX(OPT,'C').NE.0 XOPTG = INDEX(OPT,'G').NE.0 XOPTI = INDEX(OPT,'I').NE.0 XOPTL = INDEX(OPT,'L').NE.0 XOPTM = INDEX(OPT,'M').NE.0 XOPTN = INDEX(OPT,'N').NE.0 XOPTS = INDEX(OPT,'S').NE.0 XOPTT = INDEX(OPT,'T').NE.0 XOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.XOPTI) XNFORM = 0 IF (INDEX(OPT,'1').NE.0) XNFORM = 1 IF (INDEX(OPT,'2').NE.0) XNFORM = 2 CALL GRTOUP(OPT,YOPT) YOPTA = INDEX(OPT,'A').NE.0 .AND. RANGE(XBLC,0.0,XTRC) YOPTB = INDEX(OPT,'B').NE.0 YOPTC = INDEX(OPT,'C').NE.0 YOPTG = INDEX(OPT,'G').NE.0 YOPTI = INDEX(OPT,'I').NE.0 YOPTL = INDEX(OPT,'L').NE.0 YOPTN = INDEX(OPT,'N').NE.0 YOPTM = INDEX(OPT,'M').NE.0 YOPTS = INDEX(OPT,'S').NE.0 YOPTT = INDEX(OPT,'T').NE.0 YOPTV = INDEX(OPT,'V').NE.0 YOPTP = INDEX(OPT,'P').NE.0 .AND. (.NOT.YOPTI) YNFORM = 0 IF (INDEX(OPT,'1').NE.0) YNFORM = 1 IF (INDEX(OPT,'2').NE.0) YNFORM = 2 C C Displacement of labels from edge of box C (for X bottom/top, Y left/right, and Y left/right with V option). C XNDSP = 1.2 XMDSP = 0.7 YNDSP = 0.7 YMDSP = 1.2 YNVDSP = 0.7 YMVDSP = 0.7 IF (XOPTI) THEN XNDSP = XNDSP + 0.3 XMDSP = XMDSP + 0.3 END IF IF (YOPTI) THEN YNDSP = YNDSP + 0.3 YMDSP = YMDSP + 0.3 YNVDSP = YNVDSP + 0.3 YMVDSP = YMVDSP + 0.3 END IF C C Disable clipping. C CALL PGQCLP(CLIP) CALL PGSCLP(0) C C Draw box. C IF (XOPTB) THEN CALL GRMOVA(XBLC, YBLC) CALL GRLINA(XTRC, YBLC) END IF IF (YOPTC) THEN CALL GRMOVA(XTRC, YBLC) CALL GRLINA(XTRC, YTRC) END IF IF (XOPTC) THEN CALL GRMOVA(XTRC, YTRC) CALL GRLINA(XBLC, YTRC) END IF IF (YOPTB) THEN CALL GRMOVA(XBLC, YTRC) CALL GRLINA(XBLC, YBLC) END IF C C Draw axes if required. C IF (XOPTA.AND..NOT.XOPTG) THEN CALL GRMOVA(XBLC, 0.0) CALL GRLINA(XTRC, 0.0) END IF IF (YOPTA.AND..NOT.YOPTG) THEN CALL GRMOVA(0.0, YBLC) CALL GRLINA(0.0, YTRC) END IF C C Length of X tick marks. C TIKL1 = PGXSP(PGID)*0.6*(YTRC-YBLC)/PGYLEN(PGID) IF (XOPTI) TIKL1 = -TIKL1 TIKL2 = TIKL1*0.5 C C Choose X tick intervals. Major interval = XINT, C minor interval = XINT2 = XINT/NSUBX. C UTAB(1) = 0.0 IF (XOPTL) THEN XINT = SIGN(1.0,XTRC-XBLC) NSUBX = 1 DO 10 J=2,9 UTAB(J) = TAB(J) IF (XINT.LT.0.0) UTAB(J) = 1.0-TAB(J) 10 CONTINUE ELSE IF (XTICK.EQ.0.0) THEN XINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGXLEN(PGID), 0.20)) 1 *(XTRC-XBLC) XINT = PGRND(XINT,NSUBX) ELSE XINT = SIGN(XTICK,XTRC-XBLC) NSUBX = MAX(NXSUB,1) END IF IF (.NOT.XOPTS) NSUBX = 1 NP = INT(LOG10(ABS(XINT)))-4 NV = NINT(XINT/10.**NP) XINT2 = XINT/NSUBX XOPTLS = XOPTL .AND. XOPTS .AND. (ABS(XTRC-XBLC).LT.2.0) C C Draw X grid. C IF (XOPTG) THEN CALL PGBOX1(XBLC, XTRC, XINT, I1, I2) DO 20 I=I1,I2 CALL GRMOVA(REAL(I)*XINT, YBLC) CALL GRLINA(REAL(I)*XINT, YTRC) 20 CONTINUE END IF C C Draw X ticks. C IF (XOPTT.OR.XOPTS) THEN CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2) JMAX = 1 IF (XOPTL.AND.XOPTS) JMAX=9 C C Bottom ticks. C IF (XOPTB) THEN DO 40 I=I1-1,I2 DO 30 J=1,JMAX MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 XVAL = (I+UTAB(J))*XINT2 IF (IRANGE(XBLC,XVAL,XTRC)) THEN IF (XOPTP.AND.MAJOR) THEN CALL GRMOVA(XVAL, YBLC-TIKL2) ELSE CALL GRMOVA(XVAL, YBLC) END IF CALL GRLINA(XVAL, YBLC+TIKL) END IF 30 CONTINUE 40 CONTINUE END IF C C Axis ticks. C IF (XOPTA) THEN DO 60 I=I1-1,I2 DO 50 J=1,JMAX MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 XVAL = (I+UTAB(J))*XINT2 IF (IRANGE(XBLC,XVAL,XTRC)) THEN CALL GRMOVA(XVAL, -TIKL) CALL GRLINA(XVAL, TIKL) END IF 50 CONTINUE 60 CONTINUE END IF C C Top ticks. C IF (XOPTC) THEN DO 80 I=I1-1,I2 DO 70 J=1,JMAX MAJOR = (MOD(I,NSUBX).EQ.0).AND.XOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 XVAL = (I+UTAB(J))*XINT2 IF (IRANGE(XBLC,XVAL,XTRC)) THEN CALL GRMOVA(XVAL, YTRC-TIKL) CALL GRLINA(XVAL, YTRC) END IF 70 CONTINUE 80 CONTINUE END IF END IF C C Write X labels. C IF (XOPTN .OR. XOPTM) THEN CALL PGBOX1(XBLC, XTRC, XINT, I1, I2) DO 90 I=I1,I2 XC = (I*XINT-XBLC)/(XTRC-XBLC) IF (XOPTL) THEN CALL PGNUMB(1,NINT(I*XINT),XNFORM,CLBL,NC) ELSE CALL PGNUMB(I*NV,NP,XNFORM,CLBL,NC) END IF IF (XOPTN) CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC)) IF (XOPTM) CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC)) 90 CONTINUE END IF C C Extra X labels for log axes. C IF (XOPTLS) THEN CALL PGBOX1(XBLC, XTRC, XINT2, I1, I2) DO 401 I=I1-1,I2 DO 301 J=2,5,3 XVAL = (I+UTAB(J))*XINT2 XC = (XVAL-XBLC)/(XTRC-XBLC) KI = I IF (XTRC.LT.XBLC) KI = KI+1 IF (IRANGE(XBLC,XVAL,XTRC)) THEN CALL PGNUMB(J,NINT(KI*XINT2),XNFORM,CLBL,NC) IF (XOPTN) 1 CALL PGMTXT('B', XNDSP, XC, 0.5, CLBL(1:NC)) IF (XOPTM) 1 CALL PGMTXT('T', XMDSP, XC, 0.5, CLBL(1:NC)) END IF 301 CONTINUE 401 CONTINUE END IF C C Length of Y tick marks. C TIKL1 = PGXSP(PGID)*0.6*(XTRC-XBLC)/PGXLEN(PGID) IF (YOPTI) TIKL1 = -TIKL1 TIKL2 = TIKL1*0.5 C C Choose Y tick intervals. Major interval = YINT, C minor interval = YINT2 = YINT/NSUBY. C UTAB(1) = 0.0 IF (YOPTL) THEN YINT = SIGN(1.0,YTRC-YBLC) NSUBY = 1 DO 100 J=2,9 UTAB(J) = TAB(J) IF (YINT.LT.0.0) UTAB(J) = 1.0-TAB(J) 100 CONTINUE ELSE IF (YTICK.EQ.0.0) THEN YINT = MAX(0.05, MIN(7.0*PGXSP(PGID)/PGYLEN(PGID), 0.20)) 1 *(YTRC-YBLC) YINT = PGRND(YINT,NSUBY) ELSE YINT = SIGN(YTICK,YTRC-YBLC) NSUBY = MAX(NYSUB,1) END IF IF (.NOT.YOPTS) NSUBY = 1 NP = INT(LOG10(ABS(YINT)))-4 NV = NINT(YINT/10.**NP) YINT2 = YINT/NSUBY YOPTLS = YOPTL .AND. YOPTS .AND. (ABS(YTRC-YBLC).LT.2.0) C C Draw Y grid. C IF (YOPTG) THEN CALL PGBOX1(YBLC, YTRC, YINT, I1, I2) DO 110 I=I1,I2 CALL GRMOVA(XBLC, REAL(I)*YINT) CALL GRLINA(XTRC, REAL(I)*YINT) 110 CONTINUE END IF C C Draw Y ticks. C IF (YOPTT.OR.YOPTS) THEN CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2) JMAX = 1 IF (YOPTL.AND.YOPTS) JMAX = 9 C C Left ticks. C IF (YOPTB) THEN DO 130 I=I1-1,I2 DO 120 J=1,JMAX MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 YVAL = (I+UTAB(J))*YINT2 IF (IRANGE(YBLC,YVAL,YTRC)) THEN IF (YOPTP.AND.MAJOR) THEN CALL GRMOVA(XBLC-TIKL2, YVAL) ELSE CALL GRMOVA(XBLC, YVAL) END IF CALL GRLINA(XBLC+TIKL, YVAL) END IF 120 CONTINUE 130 CONTINUE END IF C C Axis ticks. C IF (YOPTA) THEN DO 150 I=I1-1,I2 DO 140 J=1,JMAX MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 YVAL = (I+UTAB(J))*YINT2 IF (IRANGE(YBLC,YVAL,YTRC)) THEN CALL GRMOVA(-TIKL, YVAL) CALL GRLINA(TIKL, YVAL) END IF 140 CONTINUE 150 CONTINUE END IF C C Right ticks. C IF (YOPTC) THEN DO 170 I=I1-1,I2 DO 160 J=1,JMAX MAJOR = (MOD(I,NSUBY).EQ.0).AND.YOPTT.AND.J.EQ.1 TIKL = TIKL2 IF (MAJOR) TIKL = TIKL1 YVAL = (I+UTAB(J))*YINT2 IF (IRANGE(YBLC,YVAL,YTRC)) THEN CALL GRMOVA(XTRC-TIKL, YVAL) CALL GRLINA(XTRC, YVAL) END IF 160 CONTINUE 170 CONTINUE END IF END IF C C Write Y labels. C IF (YOPTN.OR.YOPTM) THEN CALL PGBOX1(YBLC, YTRC, YINT, I1, I2) DO 180 I=I1,I2 YC = (I*YINT-YBLC)/(YTRC-YBLC) IF (YOPTL) THEN CALL PGNUMB(1,NINT(I*YINT),YNFORM,CLBL,NC) ELSE CALL PGNUMB(I*NV,NP,YNFORM,CLBL,NC) END IF IF (YOPTV) THEN IF (YOPTN) CALL PGMTXT('LV',YNVDSP,YC,1.0,CLBL(1:NC)) IF (YOPTM) CALL PGMTXT('RV',YMVDSP,YC,0.0,CLBL(1:NC)) ELSE IF (YOPTN) CALL PGMTXT('L',YNDSP,YC,0.5,CLBL(1:NC)) IF (YOPTM) CALL PGMTXT('R',YMDSP,YC,0.5,CLBL(1:NC)) END IF 180 CONTINUE END IF C C Extra Y labels for log axes. C IF (YOPTLS) THEN CALL PGBOX1(YBLC, YTRC, YINT2, I1, I2) DO 402 I=I1-1,I2 DO 302 J=2,5,3 YVAL = (I+UTAB(J))*YINT2 YC = (YVAL-YBLC)/(YTRC-YBLC) KI = I IF (YBLC.GT.YTRC) KI = KI+1 IF (IRANGE(YBLC,YVAL,YTRC)) THEN CALL PGNUMB(J,NINT(KI*YINT2),YNFORM,CLBL,NC) IF (YOPTV) THEN IF (YOPTN) 1 CALL PGMTXT('LV', YNVDSP, YC, 1.0, CLBL(1:NC)) IF (YOPTM) 1 CALL PGMTXT('RV', YMVDSP, YC, 0.0, CLBL(1:NC)) ELSE IF (YOPTN) 1 CALL PGMTXT('L', YNDSP, YC, 0.5, CLBL(1:NC)) IF (YOPTM) 1 CALL PGMTXT('R', YMDSP, YC, 0.5, CLBL(1:NC)) END IF END IF 302 CONTINUE 402 CONTINUE END IF C C Enable clipping. C CALL PGSCLP(CLIP) C CALL PGEBUF END box C (for X bottom/top, Y left/right, and Y left/right with V option). C XNDSP = 1.2 XMDSP = 0.7 YNDSP = 0.7 YMDSP = 1.2 YNVDSP = 0.7 YMVDSP = 0.7 IF (XOPTI) THEN XNDSP = XNDSP + 0.3 XMDSP = XMDSP + 0.3 END IF IF (YOPTI) THEN YNDSP = YNDSP + 0.3 YMDSP = YMDSP + 0.3 pgplot/src/pgpap.f010064400040640000322000000061460606641064500146150ustar00tjpcitmbr00000400000017C*PGPAP -- change the size of the view surface C%void cpgpap(float width, float aspect); C+ SUBROUTINE PGPAP (WIDTH, ASPECT) REAL WIDTH, ASPECT C C This routine changes the size of the view surface ("paper size") to a C specified width and aspect ratio (height/width), in so far as this is C possible on the specific device. It is always possible to obtain a C view surface smaller than the default size; on some devices (e.g., C printers that print on roll or fan-feed paper) it is possible to C obtain a view surface larger than the default. C C This routine should be called either immediately after PGBEG or C immediately before PGPAGE. The new size applies to all subsequent C images until the next call to PGPAP. C C Arguments: C WIDTH (input) : the requested width of the view surface in inches; C if WIDTH=0.0, PGPAP will obtain the largest view C surface available consistent with argument ASPECT. C (1 inch = 25.4 mm.) C ASPECT (input) : the aspect ratio (height/width) of the view C surface; e.g., ASPECT=1.0 gives a square view C surface, ASPECT=0.618 gives a horizontal C rectangle, ASPECT=1.618 gives a vertical rectangle. C-- C (22-Apr-1983; bug fixed 7-Jun-1988) C 6-Oct-1990 Modified to work correctly on interactive devices. C 13-Dec-1990 Make errors non-fatal [TJP]. C 14-Sep-1994 Fix bug to do with drivers changing view surface size. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL HDEF, HMAX, HREQ, WDEF, WMAX, WREQ REAL XSMAX, YSMAX, XSZ, YSZ C IF (PGNOTO('PGPAP')) RETURN IF (WIDTH.LT.0.0 .OR. ASPECT.LE.0.0) THEN CALL GRWARN('PGPAP ignored: invalid arguments') RETURN END IF C PGPFIX(PGID) = .TRUE. C -- Find default size WDEF, HDEF and maximum size WMAX, HMAX C of view surface (inches) CALL GRSIZE(PGID,XSZ,YSZ,XSMAX,YSMAX, 1 PGXPIN(PGID),PGYPIN(PGID)) WDEF = XSZ/PGXPIN(PGID) HDEF = YSZ/PGYPIN(PGID) WMAX = XSMAX/PGXPIN(PGID) HMAX = YSMAX/PGYPIN(PGID) C -- Find desired size WREQ, HREQ of view surface (inches) IF (WIDTH.NE.0.0) THEN WREQ = WIDTH HREQ = WIDTH*ASPECT ELSE WREQ = WDEF HREQ = WDEF*ASPECT IF (HREQ.GT.HDEF) THEN WREQ = HDEF/ASPECT HREQ = HDEF END IF END IF C -- Scale the requested view surface to fit the maximum C dimensions IF (WMAX.GT.0.0 .AND. WREQ.GT.WMAX) THEN WREQ = WMAX HREQ = WMAX*ASPECT END IF IF (HMAX.GT.0.0 .AND. HREQ.GT.HMAX) THEN WREQ = HMAX/ASPECT HREQ = HMAX END IF C -- Establish the new view surface dimensions XSZ = WREQ*PGXPIN(PGID) YSZ = HREQ*PGYPIN(PGID) CALL GRSETS(PGID,XSZ,YSZ) PGXSZ(PGID) = XSZ/PGNX(PGID) PGYSZ(PGID) = YSZ/PGNY(PGID) PGNXC(PGID) = PGNX(PGID) PGNYC(PGID) = PGNY(PGID) CALL PGSCH(1.0) CALL PGVSTD END pgplot/src/pgsch.f010064400040640000322000000022770606640120200146000ustar00tjpcitmbr00000400000017C*PGSCH -- set character height C%void cpgsch(float size); C+ SUBROUTINE PGSCH (SIZE) REAL SIZE C C Set the character size attribute. The size affects all text and graph C markers drawn later in the program. The default character size is C 1.0, corresponding to a character height about 1/40 the height of C the view surface. Changing the character size also scales the length C of tick marks drawn by PGBOX and terminals drawn by PGERRX and PGERRY. C C Argument: C SIZE (input) : new character size (dimensionless multiple of C the default size). C-- C (1-Mar-1983) C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL XC, XCNEW, YC, XS, YS C IF (PGNOTO('PGSCH')) RETURN C CALL GRCHSZ(PGID, XC, YC, XS, YS) IF (PGXSZ(PGID)/PGXPIN(PGID) .GT. 1 PGYSZ(PGID)/PGYPIN(PGID)) THEN XCNEW = SIZE*XC*PGYSZ(PGID)/YS/40.0 ELSE XCNEW = SIZE*XC*(PGXSZ(PGID)*PGYPIN(PGID)/PGXPIN(PGID)) 1 /YS/40.0 END IF CALL GRSETC(PGID,XCNEW) PGXSP(PGID) = XS*XCNEW/XC PGYSP(PGID) = YS*XCNEW/XC PGCHSZ(PGID) = SIZE END pgplot/src/pgvw.f010064400040640000322000000020650606640122100144530ustar00tjpcitmbr00000400000017C SUBROUTINE PGVW C C PGPLOT (internal routine): set the GRPCKG scaling transformation C and window appropriate for the current window and viewport. This C routine is called whenever the viewport or window is changed. C C Arguments: none C C (11-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C C Scale plotter in world coordinates. C PGXSCL(PGID) = PGXLEN(PGID)/ABS(PGXTRC(PGID)-PGXBLC(PGID)) PGYSCL(PGID) = PGYLEN(PGID)/ABS(PGYTRC(PGID)-PGYBLC(PGID)) IF (PGXBLC(PGID).GT.PGXTRC(PGID)) THEN PGXSCL(PGID) = -PGXSCL(PGID) END IF IF (PGYBLC(PGID).GT.PGYTRC(PGID)) THEN PGYSCL(PGID) = -PGYSCL(PGID) END IF PGXORG(PGID) = PGXOFF(PGID)-PGXBLC(PGID)*PGXSCL(PGID) PGYORG(PGID) = PGYOFF(PGID)-PGYBLC(PGID)*PGYSCL(PGID) CALL GRTRN0(PGXORG(PGID),PGYORG(PGID), 1 PGXSCL(PGID),PGYSCL(PGID)) C C Window plotter in viewport. C CALL GRAREA(PGID,PGXOFF(PGID),PGYOFF(PGID), 1 PGXLEN(PGID),PGYLEN(PGID)) END pgplot/src/pgtick.f010064400040640000322000000065420634707603400147710ustar00tjpcitmbr00000400000017C*PGTICK -- draw a single tick mark on an axis C%void cpgtick(float x1, float y1, float x2, float y2, float v, \ C% float tikl, float tikr, float disp, float orient, const char *str); C+ SUBROUTINE PGTICK (X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, : ORIENT, STR) REAL X1, Y1, X2, Y2, V, TIKL, TIKR, DISP, ORIENT CHARACTER*(*) STR C C Draw and label single tick mark on a graph axis. The tick mark is C a short line perpendicular to the direction of the axis (which is not C drawn by this routine). The optional text label is drawn with its C baseline parallel to the axis and reading in the same direction as C the axis (from point 1 to point 2). Current line and text attributes C are used. C C Arguments: C X1, Y1 (input) : world coordinates of one endpoint of the axis. C X2, Y2 (input) : world coordinates of the other endpoint of the axis. C V (input) : draw the tick mark at fraction V (0<=V<=1) along C the line from (X1,Y1) to (X2,Y2). C TIKL (input) : length of tick mark drawn to left of axis C (as seen looking from first endpoint to second), in C units of the character height. C TIKR (input) : length of major tick marks drawn to right of axis, C in units of the character height. C DISP (input) : displacement of label text to C right of axis, in units of the character height. C ORIENT (input) : orientation of label text, in degrees; angle between C baseline of text and direction of axis (0-360°). C STR (input) : text of label (may be blank). C-- C 25-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- REAL X, Y, XV1, XV2, YV1, YV2, XW1, XW2, YW1, YW2 REAL XPMM, YPMM, LENMM, ANGLE, XCH, YCH REAL TIKX, TIKY, FJUST, D, OR C C Check arguments. C IF (X1.EQ.X2 .AND. Y1.EQ.Y2) RETURN C C Get current character height (mm) [note: XCH = YCH]. C CALL PGQCS(2, XCH, YCH) C C Get x and y scales (units per mm). C CALL PGQVP(2, XV1, XV2, YV1, YV2) CALL PGQWIN(XW1, XW2, YW1, YW2) XPMM = (XW2-XW1)/(XV2-XV1) YPMM = (YW2-YW1)/(YV2-YV1) C C Length of axis in mm. C LENMM = SQRT(((X2-X1)/XPMM)**2 + ((Y2-Y1)/YPMM)**2) C C Angle of axis to horizontal (device coordinates). C ANGLE = ATAN2((Y2-Y1)/YPMM, (X2-X1)/XPMM)*57.29577951 C C (x,y) displacement for 1 character height perpendicular to axis. C TIKX = (Y1-Y2)*XCH*XPMM/(LENMM*YPMM) TIKY = (X2-X1)*XCH*YPMM/(LENMM*XPMM) C C Draw the tick mark at point (X,Y) on the axis. C X = X1 + V*(X2-X1) Y = Y1 + V*(Y2-Y1) CALL PGMOVE(X - TIKR*TIKX, Y - TIKR*TIKY) CALL PGDRAW(X + TIKL*TIKX, Y + TIKL*TIKY) C C Label the tick mark. C D = DISP IF (STR.EQ.' ') RETURN OR = MOD(ORIENT, 360.0) IF (OR.LT.0.0) OR=OR+360.0 IF (OR.GT.45.0 .AND. OR.LE.135.0) THEN FJUST = 0.0 IF (D.LT.0.0) FJUST = 1.0 ELSE IF (OR.GT.135.0 .AND. OR.LE.225.0) THEN FJUST = 0.5 IF (D.LT.0.0) D = D-1.0 ELSE IF (OR.GT.225.0 .AND. OR.LE.315.0) THEN ANGLE = ANGLE+90.0 FJUST = 1.0 IF (D.LT.0.0) FJUST = 0.0 ELSE FJUST = 0.5 IF (D.GT.0.0) D = D+1.0 END IF CALL PGPTXT(X-D*TIKX, Y-D*TIKY, ANGLE-OR, FJUST, STR) END pgplot/src/pgbbuf.f010064400040640000322000000014440606641016700147460ustar00tjpcitmbr00000400000017C*PGBBUF -- begin batch of output (buffer) C%void cpgbbuf(void); C+ SUBROUTINE PGBBUF C C Begin saving graphical output commands in an internal buffer; the C commands are held until a matching PGEBUF call (or until the buffer C is emptied by PGUPDT). This can greatly improve the efficiency of C PGPLOT. PGBBUF increments an internal counter, while PGEBUF C decrements this counter and flushes the buffer to the output C device when the counter drops to zero. PGBBUF and PGEBUF calls C should always be paired. C C Arguments: none C-- C 21-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (.NOT.PGNOTO('PGBBUF')) THEN PGBLEV(PGID) = PGBLEV(PGID) + 1 END IF END pgplot/src/pgebuf.f010064400040640000322000000013710606641040700147450ustar00tjpcitmbr00000400000017C*PGEBUF -- end batch of output (buffer) C%void cpgebuf(void); C+ SUBROUTINE PGEBUF C C A call to PGEBUF marks the end of a batch of graphical output begun C with the last call of PGBBUF. PGBBUF and PGEBUF calls should always C be paired. Each call to PGBBUF increments a counter, while each call C to PGEBUF decrements the counter. When the counter reaches 0, the C batch of output is written on the output device. C C Arguments: none C-- C 21-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (.NOT.PGNOTO('PGEBUF')) THEN PGBLEV(PGID) = MAX(0, PGBLEV(PGID) - 1) IF (PGBLEV(PGID).EQ.0) CALL GRTERM END IF END h call to PGBBUF increments a counter, while each call C to PGEBUF decrements the counter. When the counter reaches 0, the C batch of output is written on the output device. C C Arguments: none C-- C 21-Nov-1985 - new routine [TJP]. C-----------------------------pgplot/src/pgconf.f010064400040640000322000000106370630463311400147530ustar00tjpcitmbr00000400000017C*PGCONF -- fill between two contours C%void cpgconf(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float c1, float c2, const float *tr); C+ SUBROUTINE PGCONF (A, IDIM, JDIM, I1, I2, J1, J2, C1, C2, TR) INTEGER IDIM, JDIM, I1, I2, J1, J2 REAL A(IDIM,JDIM), C1, C2, TR(6) C C Shade the region between two contour levels of a function defined on C the nodes of a rectangular grid. The routine uses the current fill C attributes, hatching style (if appropriate), and color index. C C If you want to both shade between contours and draw the contour C lines, call this routine first (once for each pair of levels) and C then CALL PGCONT (or PGCONS) to draw the contour lines on top of the C shading. C C Note 1: This routine is not very efficient: it generates a polygon C fill command for each cell of the mesh that intersects the desired C area, rather than consolidating adjacent cells into a single polygon. C C Note 2: If both contours intersect all four edges of a particular C mesh cell, the program behaves badly and may consider some parts C of the cell to lie in more than one contour range. C C Note 3: If a contour crosses all four edges of a cell, this C routine may not generate the same contours as PGCONT or PGCONS C (these two routines may not agree either). Such cases are always C ambiguous and the routines use different approaches to resolving C the ambiguity. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1,I2 (input) : range of first index to be contoured (inclusive). C J1,J2 (input) : range of second index to be contoured (inclusive). C C1, C2 (input) : contour levels; note that C1 must be less than C2. C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world coordinates of the array point A(I,J) are C given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation C or shear. C-- C 03-Oct-1996 - new routine [TJP]. C----------------------------------------------------------------------- INTEGER I, J, IC, NPT, LEV LOGICAL PGNOTO REAL DVAL(5), X(8), Y(8), DELTA, XX, YY, C, R INTEGER IDELT(6) DATA IDELT/0,-1,-1,0,0,-1/ C C Check arguments. C IF (PGNOTO('PGCONF')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. : J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN IF (C1.GE.C2) RETURN CALL PGBBUF C DO 140 J=J1+1,J2 DO 130 I=I1+1,I2 DVAL(1) = A(I-1,J) DVAL(2) = A(I-1,J-1) DVAL(3) = A(I,J-1) DVAL(4) = A(I,J) DVAL(5) = DVAL(1) C NPT = 0 DO 120 IC=1,4 IF (DVAL(IC).GE.C1 .AND. DVAL(IC).LT.C2) THEN NPT = NPT+1 XX = I+IDELT(IC+1) YY = J+IDELT(IC) X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY END IF R = DVAL(IC+1)-DVAL(IC) IF (R.EQ.0.0) GOTO 120 DO 110 LEV=1,2 IF (R.GT.0.0) THEN C = C1 IF (LEV.EQ.2) C = C2 ELSE C = C2 IF (LEV.EQ.2) C = C1 END IF DELTA = (C-DVAL(IC))/R IF (DELTA.GT.0.0 .AND. DELTA.LT.1.0) THEN IF (IC.EQ.1 .OR. IC.EQ.3) THEN XX = I+IDELT(IC+1) YY = REAL(J+IDELT(IC)) + : DELTA*REAL(IDELT(IC+1)-IDELT(IC)) ELSE XX = REAL(I+IDELT(IC+1)) + : DELTA*REAL(IDELT(IC+2)-IDELT(IC+1)) YY = J+IDELT(IC) END IF NPT = NPT+1 X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY END IF 110 CONTINUE 120 CONTINUE IF (NPT.GE.3) CALL PGPOLY(NPT, X, Y) 130 CONTINUE 140 CONTINUE CALL PGEBUF END pgplot/src/pgqid.f010064400040640000322000000013570613101101300145640ustar00tjpcitmbr00000400000017C*PGQID -- inquire current device identifier C%void cpgqid(int *id); C+ SUBROUTINE PGQID (ID) INTEGER ID C C This subroutine returns the identifier of the currently C selected device, or 0 if no device is selected. The identifier is C assigned when PGOPEN is called to open the device, and may be used C as an argument to PGSLCT. Each open device has a different C identifier. C C [This routine was added to PGPLOT in Version 5.1.0.] C C Argument: C ID (output) : the identifier of the current device, or 0 if C no device is currently selected. C-- C 22-Dec-1995 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C ID = PGID END pgplot/src/grgray.f010064400040640000322000000065750571624544700150160ustar00tjpcitmbr00000400000017C*GRGRAY -- gray-scale map of a 2D data array C+ SUBROUTINE GRGRAY (A, IDIM, JDIM, I1, I2, J1, J2, 1 FG, BG, PA, MININD, MAXIND, MODE) INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE REAL A(IDIM,JDIM) REAL FG, BG REAL PA(6) C C This is a device-dependent support routine for PGGRAY. C C Draw gray-scale map of an array in current window. Array C values between FG and BG are shaded in gray levels determined C by linear interpolation. FG may be either less than or greater C than BG. Array values outside the range FG to BG are C shaded black or white as appropriate. C C GRGRAY uses GRIMG0 on devices with enough color indices available. C Note that it changes the color table to gray-scale. C Otherwise in does a random dither with GRIMG3. C C Arguments: C A (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C FG (input) : the array value which is to appear in C foreground color. C BG (input) : the array value which is to appear in C background color. C PA (input) : transformation matrix between array grid and C device coordinates (see GRCONT). C MODE (input) : transfer function. C-- C 12-Dec-1986 - Speed up plotting [J. Biretta]. C 3-Apr-1987 - Add special code for /PS, /VPS, /GR. C 2-Sep-1987 - Adapted from PGGRAY [TJP]. C 1-Dec-1988 - Put random-number generator inline [TJP]. C 3-Apr-1989 - Use "line of pixels" primitive where available [TJP]. C 6-Sep-1989 - Changes for standard Fortran-77 [TJP]. C 19-Jan-1990 - Add special code for /CPS, /VCPS [DLM] C 3-Sep-1992 - Add special code for NULL device [TJP]. C 25-Nov-1992 - Add special code for /NEXT [AFT]. C 17-Mar-1994 - Scale in device coordinates [TJP]. C 31-Aug-1994 - use GRIMG0 when appropriate [TJP]. C 7-Sep-1994 - speed up random dither [TJP]. C 8-Feb-1995 - use color ramp based on color indices 0 and 1 [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I REAL A0, A1, CR0, CG0, CB0, CR1, CG1, CB1 INTRINSIC REAL C----------------------------------------------------------------------- C C N.B. Arguments are assumed to be valid (checked by PGGRAY). C C Use GRIMG0 if this an appropriate device; first initialize the C color table to a linear ramp between the colors assigned to color C indices 0 and 1. C IF (GRGCAP(GRCIDE)(7:7).NE.'N' .AND. MAXIND-MININD .GT. 15) THEN CALL GRQCR(0, CR0, CG0, CB0) CALL GRQCR(1, CR1, CG1, CB1) DO 5 I=MININD,MAXIND A0 = REAL(I-MININD)/REAL(MAXIND-MININD) A1 = 1.0 - A0 CALL GRSCR(I, A0*CR0+A1*CR1, A0*CG0+A1*CG1, A0*CB0+A1*CB1) 5 CONTINUE CALL GRIMG0(A, IDIM, JDIM, I1, I2, J1, J2, : FG, BG, PA, MININD, MAXIND, MODE) RETURN C C Otherwise use random dither in current color index. C ELSE CALL GRIMG3(A, IDIM, JDIM, I1, I2, J1, J2, : FG, BG, PA, MODE) END IF C----------------------------------------------------------------------- END : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range opgplot/src/pgwedg.f010064400040640000322000000163040613406373000147530ustar00tjpcitmbr00000400000017C*PGWEDG -- annotate an image plot with a wedge C%void cpgwedg(const char *side, float disp, float width, \ C% float fg, float bg, const char *label); C+ SUBROUTINE PGWEDG(SIDE, DISP, WIDTH, FG, BG, LABEL) CHARACTER *(*) SIDE,LABEL REAL DISP, WIDTH, FG, BG C C Plot an annotated grey-scale or color wedge parallel to a given axis C of the the current viewport. This routine is designed to provide a C brightness/color scale for an image drawn with PGIMAG or PGGRAY. C The wedge will be drawn with the transfer function set by PGSITF C and using the color index range set by PGSCIR. C C Arguments: C SIDE (input) : The first character must be one of the characters C 'B', 'L', 'T', or 'R' signifying the Bottom, Left, C Top, or Right edge of the viewport. C The second character should be 'I' to use PGIMAG C to draw the wedge, or 'G' to use PGGRAY. C DISP (input) : the displacement of the wedge from the specified C edge of the viewport, measured outwards from the C viewport in units of the character height. Use a C negative value to write inside the viewport, a C positive value to write outside. C WIDTH (input) : The total width of the wedge including annotation, C in units of the character height. C FG (input) : The value which is to appear with shade C 1 ("foreground"). Use the values of FG and BG C that were supplied to PGGRAY or PGIMAG. C BG (input) : the value which is to appear with shade C 0 ("background"). C LABEL (input) : Optional units label. If no label is required C use ' '. C-- C 15-Oct-1992: New routine (MCS) C 2-Aug-1995: no longer needs common (TJP). C----------------------------------------------------------------------- LOGICAL PGNOTO C Temporary window coord storage. REAL WXA,WXB,WYA,WYB, XA,XB,YA,YB C Viewport coords of wedge. REAL VXA,VXB,VYA,VYB C Original and anotation character heights. REAL OLDCH, NEWCH C Size of unit character height (NDC units). REAL NDCSIZ C True if wedge plotted horizontally. LOGICAL HORIZ C Use PGIMAG (T) or PGGRAY (F). LOGICAL IMAGE C Symbolic version of SIDE. INTEGER NSIDE,BOT,TOP,LFT,RGT PARAMETER (BOT=1,TOP=2,LFT=3,RGT=4) INTEGER I REAL WEDWID, WDGINC, VWIDTH, VDISP, XCH, YCH, LABWID, FG1, BG1 C Set the fraction of WIDTH used for anotation. REAL TXTFRC PARAMETER (TXTFRC=0.6) C Char separation between numbers and LABEL. REAL TXTSEP PARAMETER (TXTSEP=2.2) C Array to draw wedge in. INTEGER WDGPIX PARAMETER (WDGPIX=100) REAL WDGARR(WDGPIX) C Define the coordinate-mapping function. REAL TR(6) SAVE TR DATA TR /0.0,1.0,0.0,0.0,0.0,1.0/ C----------------------------------------------------------------------- IF(PGNOTO('PGWEDG')) RETURN C C Get a numeric version of SIDE. C IF(SIDE(1:1).EQ.'B' .OR. SIDE(1:1).EQ.'b') THEN NSIDE = BOT HORIZ = .TRUE. ELSE IF(SIDE(1:1).EQ.'T' .OR. SIDE(1:1).EQ.'t') THEN NSIDE = TOP HORIZ = .TRUE. ELSE IF(SIDE(1:1).EQ.'L' .OR. SIDE(1:1).EQ.'l') THEN NSIDE = LFT HORIZ = .FALSE. ELSE IF(SIDE(1:1).EQ.'R' .OR. SIDE(1:1).EQ.'r') THEN NSIDE = RGT HORIZ = .FALSE. ELSE CALL GRWARN('Invalid "SIDE" argument in PGWEDG.') RETURN END IF C C Determine which routine to use. C IF (LEN(SIDE).LT.2) THEN IMAGE = .FALSE. ELSE IF(SIDE(2:2).EQ.'I' .OR. SIDE(2:2).EQ.'i') THEN IMAGE = .TRUE. ELSE IF(SIDE(2:2).EQ.'G' .OR. SIDE(2:2).EQ.'g') THEN IMAGE = .FALSE. ELSE CALL GRWARN('Invalid "SIDE" argument in PGWEDG.') END IF C CALL PGBBUF C C Store the current world and viewport coords and the character height. C CALL PGQWIN(WXA, WXB, WYA, WYB) CALL PGQVP(0, XA, XB, YA, YB) CALL PGQCH(OLDCH) C C Determine the unit character height in NDC coords. C CALL PGSCH(1.0) CALL PGQCS(0, XCH, YCH) IF(HORIZ) THEN NDCSIZ = YCH ELSE NDCSIZ = XCH END IF C C Convert 'WIDTH' and 'DISP' into viewport units. C VWIDTH = WIDTH * NDCSIZ * OLDCH VDISP = DISP * NDCSIZ * OLDCH C C Determine the number of character heights required under the wedge. C LABWID = TXTSEP IF(LABEL.NE.' ') LABWID = LABWID + 1.0 C C Determine and set the character height required to fit the wedge C anotation text within the area allowed for it. C NEWCH = TXTFRC*VWIDTH / (LABWID*NDCSIZ) CALL PGSCH(NEWCH) C C Determine the width of the wedge part of the plot minus the anotation. C (NDC units). C WEDWID = VWIDTH * (1.0-TXTFRC) C C Use these to determine viewport coordinates for the wedge + annotation. C VXA = XA VXB = XB VYA = YA VYB = YB IF(NSIDE.EQ.BOT) THEN VYB = YA - VDISP VYA = VYB - WEDWID ELSE IF(NSIDE.EQ.TOP) THEN VYA = YB + VDISP VYB = VYA + WEDWID ELSE IF(NSIDE.EQ.LFT) THEN VXB = XA - VDISP VXA = VXB - WEDWID ELSE IF(NSIDE.EQ.RGT) THEN VXA = XB + VDISP VXB = VXA + WEDWID END IF C C Set the viewport for the wedge. C CALL PGSVP(VXA, VXB, VYA, VYB) C C Swap FG/BG if necessary to get axis direction right. C FG1 = MAX(FG,BG) BG1 = MIN(FG,BG) C C Create a dummy wedge array to be plotted. C WDGINC = (FG1-BG1)/(WDGPIX-1) DO 1 I=1,WDGPIX WDGARR(I) = BG1 + (I-1) * WDGINC 1 CONTINUE C C Draw the wedge then change the world coordinates for labelling. C IF (HORIZ) THEN CALL PGSWIN(1.0, REAL(WDGPIX), 0.9, 1.1) IF (IMAGE) THEN CALL PGIMAG(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR) ELSE CALL PGGRAY(WDGARR, WDGPIX,1, 1,WDGPIX, 1,1, FG,BG, TR) END IF CALL PGSWIN(BG1,FG1,0.0,1.0) ELSE CALL PGSWIN(0.9, 1.1, 1.0, REAL(WDGPIX)) IF (IMAGE) THEN CALL PGIMAG(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR) ELSE CALL PGGRAY(WDGARR, 1,WDGPIX, 1,1, 1,WDGPIX, FG,BG, TR) END IF CALL PGSWIN(0.0, 1.0, BG1, FG1) ENDIF C C Draw a labelled frame around the wedge. C IF(NSIDE.EQ.BOT) THEN CALL PGBOX('BCNST',0.0,0,'BC',0.0,0) ELSE IF(NSIDE.EQ.TOP) THEN CALL PGBOX('BCMST',0.0,0,'BC',0.0,0) ELSE IF(NSIDE.EQ.LFT) THEN CALL PGBOX('BC',0.0,0,'BCNST',0.0,0) ELSE IF(NSIDE.EQ.RGT) THEN CALL PGBOX('BC',0.0,0,'BCMST',0.0,0) ENDIF C C Write the units label. C IF(LABEL.NE.' ') THEN CALL PGMTXT(SIDE,TXTSEP,1.0,1.0,LABEL) END IF C C Reset the original viewport and world coordinates. C CALL PGSVP(XA,XB,YA,YB) CALL PGSWIN(WXA,WXB,WYA,WYB) CALL PGSCH(OLDCH) CALL PGEBUF RETURN END pgplot/src/grsyds.f010064400040640000322000000135660605000547700150210ustar00tjpcitmbr00000400000017C*GRSYDS -- decode character string into list of symbol numbers C+ SUBROUTINE GRSYDS (SYMBOL, NSYMBS, TEXT, FONT) INTEGER SYMBOL(*), NSYMBS, FONT CHARACTER*(*) TEXT C C Given a character string, this routine returns a list of symbol C numbers to be used to plot it. It is responsible for interpreting C all escape sequences. Negative `symbol numbers' are inserted in the C list to represent pen movement. The following escape sequences are C defined (the letter following the \ may be either upper or lower C case): C C \u : up one level (returns -1) C \d : down one level (returns -2) C \b : backspace (returns -3) C \A : (upper case only) Angstrom symbol, roman font C \x : multiplication sign C \. : centered dot C \\ : \, returns the code for backslash C \gx : greek letter corresponding to roman letter x C \fn : switch to Normal font C \fr : switch to Roman font C \fi : switch to Italic font C \fs : switch to Script font C \mn or \mnn : graph marker number n or nn (1 or 2 digits) C \(nnn) : Hershey symbol number nnn (any number of digits) C C Arguments: C SYMBOL (output) : receives the list of symbol numers. C NSYMBS (output) : receives the actual number of symbols specified C by the string; it is assumed that the dimension of C SYMBOL is big enough (not less than LEN(TEXT)). C TEXT (input) : the text string to be decoded. C FONT (input) : the font number (1..4) to be used for decoding the C string (this can be overridden by an escape C sequence within the string). C-- C 3-May-1983 - [TJP]. C 13-Jun-1984 - add \A [TJP]. C 15-Dec-1988 - standardize [TJP]. C 29-Nov-1990 - add \m escapes [TJP]. C 27-Nov-1991 - add \x escape [TJP]. C 27-Jul-1995 - extend for 256-character set [TJP] C 7-Nov-1995 - add \. escape [TJP]. C----------------------------------------------------------------------- CHARACTER*8 FONTS CHARACTER*48 GREEK PARAMETER (FONTS = 'nrisNRIS') PARAMETER (GREEK = 'ABGDEZYHIKLMNCOPRSTUFXQW' // 1 'abgdezyhiklmncoprstufxqw' ) INTEGER CH, IG, J, LENTXT, IFONT, MARK C C Initialize parameters. C IFONT = FONT LENTXT = LEN(TEXT) NSYMBS = 0 J = 0 C C Get next character; treat non-printing characters as spaces. C 100 J = J+1 IF (J.GT.LENTXT) RETURN CH = ICHAR(TEXT(J:J)) IF (CH.LT.0) CH = 32 IF (CH.GT.303) CH = 32 C C Test for escape sequence (\) C IF (CH.EQ.92) THEN IF ((LENTXT-J).GE.1) THEN IF (TEXT(J+1:J+1).EQ.CHAR(92)) THEN J = J+1 ELSE IF (TEXT(J+1:J+1).EQ.'u' .OR. 1 TEXT(J+1:J+1).EQ.'U') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = -1 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'d' .OR. 1 TEXT(J+1:J+1).EQ.'D') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = -2 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'b' .OR. 1 TEXT(J+1:J+1).EQ.'B') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = -3 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'A') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = 2078 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'x') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = 2235 IF (IFONT.EQ.1) SYMBOL(NSYMBS) = 727 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'.') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = 2236 IF (IFONT.EQ.1) SYMBOL(NSYMBS) = 729 J = J+1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'(') THEN NSYMBS = NSYMBS + 1 SYMBOL(NSYMBS) = 0 J = J+2 C -- DO WHILE ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') 90 IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN SYMBOL(NSYMBS) = SYMBOL(NSYMBS)*10 + 1 ICHAR(TEXT(J:J)) - ICHAR('0') J = J+1 GOTO 90 END IF C -- end DO WHILE IF (TEXT(J:J).NE.')') J = J-1 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'m' .OR. 1 TEXT(J+1:J+1).EQ.'M') THEN MARK = 0 J = J+2 IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN MARK = MARK*10 + ICHAR(TEXT(J:J)) - ICHAR('0') J = J+1 END IF IF ('0'.LE.TEXT(J:J).AND.TEXT(J:J).LE.'9') THEN MARK = MARK*10 + ICHAR(TEXT(J:J)) - ICHAR('0') J = J+1 END IF J = J-1 NSYMBS = NSYMBS + 1 CALL GRSYMK(MARK, IFONT, SYMBOL(NSYMBS)) GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'f' .OR. 1 TEXT(J+1:J+1).EQ.'F') THEN IFONT = INDEX(FONTS, TEXT(J+2:J+2)) IF (IFONT.GT.4) IFONT = IFONT-4 IF (IFONT.EQ.0) IFONT = 1 J = J+2 GOTO 100 ELSE IF (TEXT(J+1:J+1).EQ.'g' .OR. 1 TEXT(J+1:J+1).EQ.'G') THEN IG = INDEX(GREEK, TEXT(J+2:J+2)) NSYMBS = NSYMBS + 1 CALL GRSYMK(255+IG, IFONT, SYMBOL(NSYMBS)) J = J+2 GOTO 100 END IF END IF END IF C C Decode character. C NSYMBS = NSYMBS + 1 CALL GRSYMK(CH, IFONT, SYMBOL(NSYMBS)) GOTO 100 END pgplot/src/pgarro.f010064400040640000322000000063050555255505600150020ustar00tjpcitmbr00000400000017C*PGARRO -- draw an arrow C%void cpgarro(float x1, float y1, float x2, float y2); C+ SUBROUTINE PGARRO (X1, Y1, X2, Y2) REAL X1, Y1, X2, Y2 C C Draw an arrow from the point with world-coordinates (X1,Y1) to C (X2,Y2). The size of the arrowhead at (X2,Y2) is determined by C the current character size set by routine PGSCH. The default size C is 1/40th of the smaller of the width or height of the view surface. C The appearance of the arrowhead (shape and solid or open) is C controlled by routine PGSAH. C C Arguments: C X1, Y1 (input) : world coordinates of the tail of the arrow. C X2, Y2 (input) : world coordinates of the head of the arrow. C-- C 7-Feb-92 Keith Horne @ STScI / TJP. C 13-Oct-92 - use arrowhead attributes; scale (TJP). C----------------------------------------------------------------------- INTEGER AHFS, FS REAL DX, DY, XV1, XV2, YV1, YV2, XL, XR, YB, YT, DINDX, DINDY REAL XINCH, YINCH, RINCH, CA, SA, SO, CO, YP, XP, YM, XM, DHX, DHY REAL PX(4), PY(4) REAL AHANGL, AHVENT, SEMANG, CH, DH, XS1, XS2, YS1, YS2 C CALL PGBBUF CALL PGQAH(AHFS, AHANGL, AHVENT) CALL PGQFS(FS) CALL PGSFS(AHFS) DX = X2 - X1 DY = Y2 - Y1 CALL PGQCH(CH) CALL PGQVSZ(1, XS1, XS2, YS1, YS2) C -- length of arrowhead: 1 40th of the smaller of the height or C width of the view surface, scaled by character height. DH = CH*MIN(ABS(XS2-XS1),ABS(YS2-YS1))/40.0 CALL PGMOVE(X2, Y2) C -- Is there to be an arrowhead ? IF (DH.GT.0.) THEN IF (DX.NE.0. .OR. DY.NE.0.) THEN C -- Get x and y scales CALL PGQVP(1, XV1, XV2, YV1, YV2) CALL PGQWIN(XL, XR, YB, YT) IF (XR.NE.XL .AND. YT.NE.YB) THEN DINDX = (XV2 - XV1) / (XR - XL) DINDY = (YV2 - YV1) / (YT - YB) DHX = DH / DINDX DHY = DH / DINDY C -- Unit vector in direction of the arrow XINCH = DX * DINDX YINCH = DY * DINDY RINCH = SQRT(XINCH*XINCH + YINCH*YINCH) CA = XINCH / RINCH SA = YINCH / RINCH C -- Semiangle in radians SEMANG = AHANGL/2.0/57.296 SO = SIN(SEMANG) CO = -COS(SEMANG) C -- Vector back along one edge of the arrow XP = DHX * (CA*CO - SA*SO) YP = DHY * (SA*CO + CA*SO) C -- Vector back along other edge of the arrow XM = DHX * (CA*CO + SA*SO) YM = DHY * (SA*CO - CA*SO) C -- Draw the arrowhead PX(1) = X2 PY(1) = Y2 PX(2) = X2 + XP PY(2) = Y2 + YP PX(3) = X2 + 0.5*(XP+XM)*(1.0-AHVENT) PY(3) = Y2 + 0.5*(YP+YM)*(1.0-AHVENT) PX(4) = X2 + XM PY(4) = Y2 + YM CALL PGPOLY(4, PX, PY) CALL PGMOVE(PX(3), PY(3)) END IF END IF END IF CALL PGDRAW(X1, Y1) CALL PGMOVE(X2,Y2) CALL PGSFS(FS) CALL PGEBUF RETURN END pgplot/src/pgbin.f010064400040640000322000000051150613406370200145720ustar00tjpcitmbr00000400000017C*PGBIN -- histogram of binned data C%void cpgbin(int nbin, const float *x, const float *data, \ C% Logical center); C+ SUBROUTINE PGBIN (NBIN, X, DATA, CENTER) INTEGER NBIN REAL X(*), DATA(*) LOGICAL CENTER C C Plot a histogram of NBIN values with X(1..NBIN) values along C the ordinate, and DATA(1...NBIN) along the abscissa. Bin width is C spacing between X values. C C Arguments: C NBIN (input) : number of values. C X (input) : abscissae of bins. C DATA (input) : data values of bins. C CENTER (input) : if .TRUE., the X values denote the center of the C bin; if .FALSE., the X values denote the lower C edge (in X) of the bin. C-- C 19-Aug-92: change argument check (TJP). C----------------------------------------------------------------------- LOGICAL PGNOTO INTEGER IBIN REAL TX(4), TY(4) C C Check arguments. C IF (NBIN.LT.2) RETURN IF (PGNOTO('PGBIN')) RETURN CALL PGBBUF C C Draw Histogram. Centered an uncentered bins are treated separately. C IF (CENTER) THEN C !set up initial point. TX(2) = (3.*X(1) - X(2))/2. TY(2) = DATA(1) TX(3) = (X(1) + X(2))/2. TY(3) = TY(2) CALL GRVCT0(2, .FALSE., 2, TX(2), TY(2)) C !draw initial horizontal line C !now loop over bins DO 10 IBIN=2,NBIN-1 TX(1) = TX(3) TX(2) = TX(1) TX(3) = ( X(IBIN) + X(IBIN+1) ) / 2. TY(1) = TY(3) TY(2) = DATA(IBIN) TY(3) = TY(2) CALL GRVCT0(2, .FALSE., 3, TX, TY) 10 CONTINUE C !now draw last segment. TX(1) = TX(3) TX(2) = TX(1) TX(3) = (3.*X(NBIN) - X(NBIN-1) )/2. TY(1) = TY(3) TY(2) = DATA(NBIN) TY(3) = TY(2) CALL GRVCT0(2, .FALSE., 3, TX, TY) C C Uncentered bins C ELSE C !set up first line. TX(2) = X(1) TY(2) = DATA(1) TX(3) = X(2) TY(3) = TY(2) CALL GRVCT0(2, .FALSE., 2, TX(2), TY(2)) DO 20 IBIN=2,NBIN TX(1) = TX(3) TX(2) = TX(1) IF (IBIN.EQ.NBIN) THEN TX(3) = 2.*X(NBIN) - X(NBIN-1) ELSE TX(3) = X(IBIN+1) END IF TY(1) = TY(3) C !get height for last segment. TY(2) = DATA(IBIN) TY(3) = TY(2) CALL GRVCT0(2, .FALSE., 3, TX, TY) 20 CONTINUE END IF C CALL PGEBUF END pgplot/src/pgbox1.f010064400040640000322000000026500555255505700147100ustar00tjpcitmbr00000400000017C PGBOX1 -- support routine for PGBOX C SUBROUTINE PGBOX1 (XA, XB, XD, I1, I2) REAL XA, XB, XD INTEGER I1, I2 C C This routine is used to determine where to draw the tick marks on C an axis. The input arguments XA and XB are the world-coordinate C end points of the axis; XD is the tick interval. PGBOX1 returns C two integers, I1 and I2, such that the required tick marks are C to be placed at world-coordinates (I*XD), for I=I1,...,I2. C Normally I2 is greater than or equal to I1, but if there are no C values of I such that I*XD lies in the inclusive range (XA, XB), C then I2 will be 1 less than I1. C C Arguments: C XA, XB (input) : world-coordinate end points of the axis. XA must C not be equal to XB; otherwise, there are no C restrictions. C XD (input) : world-coordinate tick interval. XD may be positive C or negative, but may not be zero. C I1, I2 (output) : tick marks should be drawn at world C coordinates I*XD for I in the inclusive range C I1...I2 (see above). C C 14-Jan-1986 - new routine [TJP]. C 13-Dec-1990 - remove rror check [TJP]. C----------------------------------------------------------------------- REAL XLO, XHI C XLO = MIN(XA/XD, XB/XD) XHI = MAX(XA/XD, XB/XD) I1 = NINT(XLO) IF (I1.LT.XLO) I1 = I1+1 I2 = NINT(XHI) IF (I2.GT.XHI) I2 = I2-1 END pgplot/src/pgconb.f010064400040640000322000000131050613406370400147430ustar00tjpcitmbr00000400000017C*PGCONB -- contour map of a 2D data array, with blanking C%void cpgconb(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr, \ C% float blank); C+ SUBROUTINE PGCONB (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR, 1 BLANK) INTEGER IDIM, JDIM, I1, I2, J1, J2, NC REAL A(IDIM,JDIM), C(*), TR(6), BLANK C C Draw a contour map of an array. This routine is the same as PGCONS, C except that array elements that have the "magic value" defined by C argument BLANK are ignored, making gaps in the contour map. The C routine may be useful for data measured on most but not all of the C points of a grid. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1,I2 (input) : range of first index to be contoured (inclusive). C J1,J2 (input) : range of second index to be contoured (inclusive). C C (input) : array of contour levels (in the same units as the C data in array A); dimension at least NC. C NC (input) : number of contour levels (less than or equal to C dimension of C). The absolute value of this C argument is used (for compatibility with PGCONT, C where the sign of NC is significant). C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world coordinates of the array point A(I,J) are C given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation C or shear. C BLANK (input) : elements of array A that are exactly equal to C this value are ignored (blanked). C-- C 21-Sep-1989 - Derived from PGCONS [TJP]. C----------------------------------------------------------------------- INTEGER I, IC, ICORN, IDELT(6), J, K, NPT INTEGER IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT LOGICAL PGNOTO REAL CTR, DELTA, DVAL(5), XX, YY, X(4), Y(4) INTRINSIC ABS DATA IDELT/0,-1,-1,0,0,-1/ DATA IOFF/-2,-2,-1,-1, 0, 0, 1, 1/ DATA JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/ C C Check arguments. C IF (PGNOTO('PGCONB')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN IF (NC.EQ.0) RETURN CALL PGBBUF C DO 130 J=J1+1,J2 DO 130 I=I1+1,I2 DVAL(1) = A(I-1,J) DVAL(2) = A(I-1,J-1) DVAL(3) = A(I,J-1) DVAL(4) = A(I,J) DVAL(5) = DVAL(1) IF (DVAL(1).EQ.BLANK .OR. DVAL(2).EQ.BLANK .OR. 1 DVAL(3).EQ.BLANK .OR. DVAL(4).EQ.BLANK) GOTO 130 DO 110 IC=1,ABS(NC) CTR = C(IC) NPT = 0 DO 120 ICORN=1,4 IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR) 1 .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120 NPT=NPT+1 DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN)) GOTO (60,70,60,70), ICORN C 60 XX = I+IDELT(ICORN+1) YY = REAL(J+IDELT(ICORN)) + 1 DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN)) GOTO 80 C 70 XX = REAL(I+IDELT(ICORN+1)) + 1 DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1)) YY = J+IDELT(ICORN) C 80 X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY C 120 CONTINUE IF (NPT.EQ.2) THEN C -- Contour crosses two sides of cell. Draw line-segment. CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) ELSE IF (NPT.EQ.4) THEN C -- The 'ambiguous' case. The routine must draw two line C segments here and there are two ways to do so. The C following 4 lines would implement the original PGPLOT C method: C CALL PGCP(0,X(1),Y(1),CTR) C CALL PGCP(1,X(2),Y(2),CTR) C CALL PGCP(0,X(3),Y(3),CTR) C CALL PGCP(1,X(4),Y(4),CTR) C -- Choose between \\ and // based on the 8 points just C outside the current box. If half or more of these points C lie below the contour level, then draw the lines such that C the high corners lie between the lines, otherwise, draw C the lines such that the low corners are enclosed. Care is C taken to avoid going off the edge. ITOT=0 ILO=0 DO 140 K=1,8 ITMP=I+IOFF(K) JTMP=J+JOFF(K) IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140 IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140 IF(A(ITMP,JTMP).EQ.BLANK) GOTO 140 ITOT=ITOT+1 IF(A(ITMP,JTMP).LT.CTR) ILO=ILO+1 140 CONTINUE IENC=+1 IF(ILO.LT.ITOT/2) IENC=-1 IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR. : IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(4),Y(4)) ELSE CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(4),Y(4)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(2),Y(2)) END IF END IF 110 CONTINUE 130 CONTINUE C CALL PGEBUF END at least NC. C NC (input) : number of contour levels (less than or equal to C dimension of C). The absolute value of this C argument is used (for compatibility with PGCONT, C where the sign of NC is significant). C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world pgplot/src/pgcons.f010064400040640000322000000133060613406370600147710ustar00tjpcitmbr00000400000017C*PGCONS -- contour map of a 2D data array (fast algorithm) C%void cpgcons(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr); C+ SUBROUTINE PGCONS (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR) INTEGER IDIM, JDIM, I1, I2, J1, J2, NC REAL A(IDIM,JDIM), C(*), TR(6) C C Draw a contour map of an array. The map is truncated if C necessary at the boundaries of the viewport. Each contour line is C drawn with the current line attributes (color index, style, and C width). This routine, unlike PGCONT, does not draw each contour as a C continuous line, but draws the straight line segments composing each C contour in a random order. It is thus not suitable for use on pen C plotters, and it usually gives unsatisfactory results with dashed or C dotted lines. It is, however, faster than PGCONT, especially if C several contour levels are drawn with one call of PGCONS. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1,I2 (input) : range of first index to be contoured (inclusive). C J1,J2 (input) : range of second index to be contoured (inclusive). C C (input) : array of contour levels (in the same units as the C data in array A); dimension at least NC. C NC (input) : number of contour levels (less than or equal to C dimension of C). The absolute value of this C argument is used (for compatibility with PGCONT, C where the sign of NC is significant). C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world coordinates of the array point A(I,J) are C given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation C or shear. C-- C 27-Aug-1984 - [TJP]. C 21-Sep-1989 - Better treatment of the 'ambiguous' case [A. Tennant]; C compute world coordinates internally and eliminate C dependence on common block [TJP]. C----------------------------------------------------------------------- INTEGER I, IC, ICORN, IDELT(6), J, K, NPT INTEGER IOFF(8), JOFF(8), IENC, ITMP, JTMP, ILO, ITOT LOGICAL PGNOTO REAL CTR, DELTA, DVAL(5), XX, YY, X(4), Y(4) INTRINSIC ABS DATA IDELT/0,-1,-1,0,0,-1/ DATA IOFF/-2,-2,-1,-1, 0, 0, 1, 1/ DATA JOFF/ 0,-1,-2, 1,-2, 1,-1, 0/ C C Check arguments. C IF (PGNOTO('PGCONS')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) RETURN IF (NC.EQ.0) RETURN CALL PGBBUF C DO 130 J=J1+1,J2 DO 130 I=I1+1,I2 DVAL(1) = A(I-1,J) DVAL(2) = A(I-1,J-1) DVAL(3) = A(I,J-1) DVAL(4) = A(I,J) DVAL(5) = DVAL(1) DO 110 IC=1,ABS(NC) CTR = C(IC) NPT = 0 DO 120 ICORN=1,4 IF( (DVAL(ICORN).LT.CTR .AND. DVAL(ICORN+1).LT.CTR) 1 .OR.(DVAL(ICORN).GE.CTR .AND. DVAL(ICORN+1).GE.CTR) ) GOTO 120 NPT=NPT+1 DELTA = (CTR-DVAL(ICORN))/(DVAL(ICORN+1)-DVAL(ICORN)) GOTO (60,70,60,70), ICORN C 60 XX = I+IDELT(ICORN+1) YY = REAL(J+IDELT(ICORN)) + 1 DELTA*REAL(IDELT(ICORN+1)-IDELT(ICORN)) GOTO 80 C 70 XX = REAL(I+IDELT(ICORN+1)) + 1 DELTA*REAL(IDELT(ICORN+2)-IDELT(ICORN+1)) YY = J+IDELT(ICORN) C 80 X(NPT) = TR(1) + TR(2)*XX + TR(3)*YY Y(NPT) = TR(4) + TR(5)*XX + TR(6)*YY C 120 CONTINUE IF (NPT.EQ.2) THEN C -- Contour crosses two sides of cell. Draw line-segment. CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) ELSE IF (NPT.EQ.4) THEN C -- The 'ambiguous' case. The routine must draw two line C segments here and there are two ways to do so. The C following 4 lines would implement the original PGPLOT C method: C CALL PGCP(0,X(1),Y(1),CTR) C CALL PGCP(1,X(2),Y(2),CTR) C CALL PGCP(0,X(3),Y(3),CTR) C CALL PGCP(1,X(4),Y(4),CTR) C -- Choose between \\ and // based on the 8 points just C outside the current box. If half or more of these points C lie below the contour level, then draw the lines such that C the high corners lie between the lines, otherwise, draw C the lines such that the low corners are enclosed. Care is C taken to avoid going off the edge. ITOT=0 ILO=0 DO 140 K=1,8 ITMP=I+IOFF(K) JTMP=J+JOFF(K) IF(ITMP.LT.I1 .OR. ITMP.GT.I2) GOTO 140 IF(JTMP.LT.J1 .OR. JTMP.GT.J2) GOTO 140 ITOT=ITOT+1 IF(A(ITMP,JTMP).LT.CTR) ILO=ILO+1 140 CONTINUE IENC=+1 IF(ILO.LT.ITOT/2) IENC=-1 IF(IENC.LT.0 .AND. DVAL(1).LT.CTR .OR. : IENC.GT.0 .AND. DVAL(1).GE.CTR) THEN CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(2),Y(2)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(4),Y(4)) ELSE CALL PGMOVE(X(1),Y(1)) CALL PGDRAW(X(4),Y(4)) CALL PGMOVE(X(3),Y(3)) CALL PGDRAW(X(2),Y(2)) END IF END IF 110 CONTINUE 130 CONTINUE C CALL PGEBUF END pgplot/src/pgcont.f010064400040640000322000000053250613406370600147740ustar00tjpcitmbr00000400000017C*PGCONT -- contour map of a 2D data array (contour-following) C%void cpgcont(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr); C+ SUBROUTINE PGCONT (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR) INTEGER IDIM, JDIM, I1, J1, I2, J2, NC REAL A(IDIM,JDIM), C(*), TR(6) C C Draw a contour map of an array. The map is truncated if C necessary at the boundaries of the viewport. Each contour line C is drawn with the current line attributes (color index, style, and C width); except that if argument NC is positive (see below), the line C style is set by PGCONT to 1 (solid) for positive contours or 2 C (dashed) for negative contours. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1, I2 (input) : range of first index to be contoured (inclusive). C J1, J2 (input) : range of second index to be contoured (inclusive). C C (input) : array of NC contour levels; dimension at least NC. C NC (input) : +/- number of contour levels (less than or equal C to dimension of C). If NC is positive, it is the C number of contour levels, and the line-style is C chosen automatically as described above. If NC is C negative, it is minus the number of contour C levels, and the current setting of line-style is C used for all the contours. C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. C The world coordinates of the array point A(I,J) C are given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation or C shear. C-- C (7-Feb-1983) C (24-Aug-1984) Revised to add the option of not automatically C setting the line-style. Sorry about the ugly way this is C done (negative NC); this is the least incompatible way of doing C it (TJP). C (21-Sep-1989) Changed to call PGCONX instead of duplicating the code C [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER I LOGICAL PGNOTO EXTERNAL PGCP C IF (PGNOTO('PGCONT')) RETURN C C Save TRANS matrix. C DO 10 I=1,6 TRANS(I) = TR(I) 10 CONTINUE C C Use PGCONX with external function PGCP, which applies the TRANS C scaling. C CALL PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, PGCP) C END , and the line-style is C chosen automatically as described above. If NC is C negative, it is minus the number of contour C levels, and the current setting of line-style is C used for all the contours. C TR (input) : arraypgplot/src/pgcp.f010064400040640000322000000015370555255506000144360ustar00tjpcitmbr00000400000017C SUBROUTINE PGCP (K, X, Y, Z) C C PGPLOT (internal routine): Draw one contour segment (for use by C PGCNSC). C C Arguments: C C K (input, integer): if K=0, move the pen to (X,Y); if K=1, draw C a line from the current position to (X,Y); otherwise C do nothing. C X (input, real): X world-coordinate of end point. C Y (input, real): Y world-coordinate of end point. C Z (input, real): the value of the contour level, not used by PGCP at C the moment. C C (7-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER K REAL X,XX,Y,YY,Z C XX = TRANS(1) + TRANS(2)*X + TRANS(3)*Y YY = TRANS(4) + TRANS(5)*X + TRANS(6)*Y IF (K.EQ.1) THEN CALL GRLINA(XX,YY) ELSE IF (K.EQ.0) THEN CALL GRMOVA(XX,YY) END IF END pgplot/src/pgcurs.f010064400040640000322000000032350570704753400150110ustar00tjpcitmbr00000400000017C*PGCURS -- read cursor position C%int cpgcurs(float *x, float *y, char *ch_scalar); C+ INTEGER FUNCTION PGCURS (X, Y, CH) REAL X, Y CHARACTER*(*) CH C C Read the cursor position and a character typed by the user. C The position is returned in world coordinates. PGCURS positions C the cursor at the position specified, allows the user to move the C cursor using the joystick or arrow keys or whatever is available on C the device. When he has positioned the cursor, the user types a C single character on the keyboard; PGCURS then returns this C character and the new cursor position (in world coordinates). C C Returns: C PGCURS : 1 if the call was successful; 0 if the device C has no cursor or some other error occurs. C Arguments: C X (in/out) : the world x-coordinate of the cursor. C Y (in/out) : the world y-coordinate of the cursor. C CH (output) : the character typed by the user; if the device has C no cursor or if some other error occurs, the value C CHAR(0) [ASCII NUL character] is returned. C C Note: The cursor coordinates (X,Y) may be changed by PGCURS even if C the device has no cursor or if the user does not move the cursor. C Under these circumstances, the position returned in (X,Y) is that of C the pixel nearest to the requested position. C-- C 7-Sep-1994 - changed to use PGBAND [TJP]. C----------------------------------------------------------------------- INTEGER PGBAND LOGICAL PGNOTO C IF (PGNOTO('PGCURS')) THEN CH = CHAR(0) PGCURS = 0 ELSE PGCURS = PGBAND(0, 1, 0.0, 0.0, X, Y, CH) END IF END pgplot/src/pgdraw.f010064400040640000322000000012300555255506000147570ustar00tjpcitmbr00000400000017C*PGDRAW -- draw a line from the current pen position to a point C%void cpgdraw(float x, float y); C+ SUBROUTINE PGDRAW (X, Y) REAL X, Y C C Draw a line from the current pen position to the point C with world-coordinates (X,Y). The line is clipped at the edge of the C current window. The new pen position is (X,Y) in world coordinates. C C Arguments: C X (input) : world x-coordinate of the end point of the line. C Y (input) : world y-coordinate of the end point of the line. C-- C 27-Nov-1986 C----------------------------------------------------------------------- CALL PGBBUF CALL GRLINA(X,Y) CALL PGEBUF END pgplot/src/pgenv.f010064400040640000322000000107440566745112700146320ustar00tjpcitmbr00000400000017C*PGENV -- set window and viewport and draw labeled frame C%void cpgenv(float xmin, float xmax, float ymin, float ymax, \ C% int just, int axis); C+ SUBROUTINE PGENV (XMIN, XMAX, YMIN, YMAX, JUST, AXIS) REAL XMIN, XMAX, YMIN, YMAX INTEGER JUST, AXIS C C Set PGPLOT "Plotter Environment". PGENV establishes the scaling C for subsequent calls to PGPT, PGLINE, etc. The plotter is C advanced to a new page or panel, clearing the screen if necessary. C If the "prompt state" is ON (see PGASK), confirmation C is requested from the user before clearing the screen. C If requested, a box, axes, labels, etc. are drawn according to C the setting of argument AXIS. C C Arguments: C XMIN (input) : the world x-coordinate at the bottom left corner C of the viewport. C XMAX (input) : the world x-coordinate at the top right corner C of the viewport (note XMAX may be less than XMIN). C YMIN (input) : the world y-coordinate at the bottom left corner C of the viewport. C YMAX (input) : the world y-coordinate at the top right corner C of the viewport (note YMAX may be less than YMIN). C JUST (input) : if JUST=1, the scales of the x and y axes (in C world coordinates per inch) will be equal, C otherwise they will be scaled independently. C AXIS (input) : controls the plotting of axes, tick marks, etc: C AXIS = -2 : draw no box, axes or labels; C AXIS = -1 : draw box only; C AXIS = 0 : draw box and label it with coordinates; C AXIS = 1 : same as AXIS=0, but also draw the C coordinate axes (X=0, Y=0); C AXIS = 2 : same as AXIS=1, but also draw grid lines C at major increments of the coordinates; C AXIS = 10 : draw box and label X-axis logarithmically; C AXIS = 20 : draw box and label Y-axis logarithmically; C AXIS = 30 : draw box and label both axes logarithmically. C C For other axis options, use routine PGBOX. PGENV can be persuaded to C call PGBOX with additional axis options by defining an environment C parameter PGPLOT_ENVOPT containing the required option codes. C Examples: C PGPLOT_ENVOPT=P ! draw Projecting tick marks C PGPLOT_ENVOPT=I ! Invert the tick marks C PGPLOT_ENVOPT=IV ! Invert tick marks and label y Vertically C-- C 1-May-1983 C 25-Sep-1985 [TJP] - change to use PGWNAD. C 23-Nov-1985 [TJP] - add PGPLOT_ENVOPT option. C 31-Dec-1985 [TJP] - remove automatic PGBEG call. C 29-Aug-1989 [TJP] - remove common block; no longer needed. C----------------------------------------------------------------------- INTEGER L LOGICAL PGNOTO CHARACTER*10 XOPTS, YOPTS, ENVOPT, TEMP C IF (PGNOTO('PGENV')) RETURN C C Start a new picture: move to a new panel or page as necessary. C CALL PGPAGE C C Redefine the standard viewport. C CALL PGVSTD C C If invalid arguments are specified, issue warning and leave window C unchanged. C IF (XMIN.EQ.XMAX) THEN CALL GRWARN('invalid x limits in PGENV: XMIN = XMAX.') RETURN ELSE IF (YMIN.EQ.YMAX) THEN CALL GRWARN('invalid y limits in PGENV: YMIN = YMAX.') RETURN END IF C C Call PGSWIN to define the window. C If equal-scales requested, adjust viewport. C IF (JUST.EQ.1) THEN CALL PGWNAD(XMIN,XMAX,YMIN,YMAX) ELSE CALL PGSWIN(XMIN,XMAX,YMIN,YMAX) END IF C C Call PGBOX to draw and label frame around viewport. C YOPTS = '*' IF (AXIS.EQ.-2) THEN XOPTS = ' ' ELSE IF (AXIS.EQ.-1) THEN XOPTS = 'BC' ELSE IF (AXIS.EQ.0) THEN XOPTS = 'BCNST' ELSE IF (AXIS.EQ.1) THEN XOPTS = 'ABCNST' ELSE IF (AXIS.EQ.2) THEN XOPTS = 'ABCGNST' ELSE IF (AXIS.EQ.10) THEN XOPTS = 'BCNSTL' YOPTS = 'BCNST' ELSE IF (AXIS.EQ.20) THEN XOPTS = 'BCNST' YOPTS = 'BCNSTL' ELSE IF (AXIS.EQ.30) THEN XOPTS = 'BCNSTL' YOPTS = 'BCNSTL' ELSE CALL GRWARN('PGENV: illegal AXIS argument.') XOPTS = 'BCNST' END IF IF (YOPTS.EQ.'*') YOPTS = XOPTS C C Additional PGBOX options from PGPLOT_ENVOPT. C CALL GRGENV('ENVOPT', ENVOPT, L) IF (L.GT.0 .AND. AXIS.GE.0) THEN TEMP = XOPTS XOPTS = ENVOPT(1:L)//TEMP TEMP = YOPTS YOPTS = ENVOPT(1:L)//TEMP END IF CALL PGBOX(XOPTS, 0.0, 0, YOPTS, 0.0, 0) C END s options, use routine PGBOXpgplot/src/pgetxt.f010064400040640000322000000010570555255506100150160ustar00tjpcitmbr00000400000017C*PGETXT -- erase text from graphics display C%void cpgetxt(void); C+ SUBROUTINE PGETXT C C Some graphics terminals display text (the normal interactive dialog) C on the same screen as graphics. This routine erases the text from the C view surface without affecting the graphics. It does nothing on C devices which do not display text on the graphics screen, and on C devices which do not have this capability. C C Arguments: C None C-- C 18-Feb-1988 C----------------------------------------------------------------------- CALL GRETXT END pgplot/src/pgfunt.f010064400040640000322000000051030555255506100150020ustar00tjpcitmbr00000400000017C*PGFUNT -- function defined by X = F(T), Y = G(T) C+ SUBROUTINE PGFUNT (FX, FY, N, TMIN, TMAX, PGFLAG) REAL FX, FY EXTERNAL FX, FY INTEGER N REAL TMIN, TMAX INTEGER PGFLAG C C Draw a curve defined by parametric equations X = FX(T), Y = FY(T). C C Arguments: C FX (external real function): supplied by the user, evaluates C X-coordinate. C FY (external real function): supplied by the user, evaluates C Y-coordinate. C N (input) : the number of points required to define the C curve. The functions FX and FY will each be C called N+1 times. C TMIN (input) : the minimum value for the parameter T. C TMAX (input) : the maximum value for the parameter T. C PGFLAG (input) : if PGFLAG = 1, the curve is plotted in the C current window and viewport; if PGFLAG = 0, C PGENV is called automatically by PGFUNT to C start a new plot with automatic scaling. C C Note: The functions FX and FY must be declared EXTERNAL in the C Fortran program unit that calls PGFUNT. C-- C 5-Oct-1983 C 11-May-1990 - remove unnecessary include [TJP]. C 13-Dec-1990 - make errors non-fatal [TJP]. C----------------------------------------------------------------------- INTEGER MAXP PARAMETER (MAXP=1000) INTEGER I REAL X(0:MAXP), Y(0:MAXP), DT REAL XMIN, XMAX, YMIN, YMAX C IF (N.LT.1 .OR. N.GT.MAXP) THEN CALL GRWARN('PGFUNT: invalid arguments') RETURN END IF CALL PGBBUF C C Evaluate function. C DT = (TMAX-TMIN)/N X(0) = FX(TMIN) Y(0) = FY(TMIN) XMIN = X(0) XMAX = X(0) YMIN = Y(0) YMAX = Y(0) DO 10 I=1,N X(I) = FX(TMIN+DT*I) Y(I) = FY(TMIN+DT*I) XMIN = MIN(XMIN,X(I)) XMAX = MAX(XMAX,X(I)) YMIN = MIN(YMIN,Y(I)) YMAX = MAX(YMAX,Y(I)) 10 CONTINUE DT = 0.05*(XMAX-XMIN) IF (DT.EQ.0.0) THEN XMIN = XMIN - 1.0 XMAX = XMAX + 1.0 ELSE XMIN = XMIN - DT XMAX = XMAX + DT END IF DT = 0.05*(YMAX-YMIN) IF (DT.EQ.0.0) THEN YMIN = YMIN - 1.0 YMAX = YMAX + 1.0 ELSE YMIN = YMIN - DT YMAX = YMAX + DT END IF C C Define environment if necessary. C IF (PGFLAG.EQ.0) CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0) C C Draw curve. C CALL PGMOVE(X(0),Y(0)) DO 20 I=1,N CALL PGDRAW(X(I),Y(I)) 20 CONTINUE C CALL PGEBUF END pgplot/src/pgfunx.f010064400040640000322000000053150555255506100150130ustar00tjpcitmbr00000400000017C*PGFUNX -- function defined by Y = F(X) C+ SUBROUTINE PGFUNX (FY, N, XMIN, XMAX, PGFLAG) REAL FY EXTERNAL FY INTEGER N REAL XMIN, XMAX INTEGER PGFLAG C C Draw a curve defined by the equation Y = FY(X), where FY is a C user-supplied subroutine. C C Arguments: C FY (external real function): supplied by the user, evaluates C Y value at a given X-coordinate. C N (input) : the number of points required to define the C curve. The function FY will be called N+1 times. C If PGFLAG=0 and N is greater than 1000, 1000 C will be used instead. If N is less than 1, C nothing will be drawn. C XMIN (input) : the minimum value of X. C XMAX (input) : the maximum value of X. C PGFLAG (input) : if PGFLAG = 1, the curve is plotted in the C current window and viewport; if PGFLAG = 0, C PGENV is called automatically by PGFUNX to C start a new plot with X limits (XMIN, XMAX) C and automatic scaling in Y. C C Note: The function FY must be declared EXTERNAL in the Fortran C program unit that calls PGFUNX. It has one argument, the C x-coordinate at which the y value is required, e.g. C REAL FUNCTION FY(X) C REAL X C FY = ..... C END C-- C 6-Oct-1983 - TJP. C 6-May-1985 - fix Y(0) bug - TJP. C 11-May-1990 - remove unnecessary include - TJP. C----------------------------------------------------------------------- INTEGER MAXP PARAMETER (MAXP=1000) INTEGER I, NN REAL Y(0:MAXP), DT, DY REAL YMIN, YMAX C C Check N > 1, and find parameter increment. C IF (N.LT.1) RETURN DT = (XMAX-XMIN)/N CALL PGBBUF C C Case 1: we do not have to find limits. C IF (PGFLAG.NE.0) THEN CALL PGMOVE(XMIN,FY(XMIN)) DO 10 I=1,N CALL PGDRAW(XMIN+I*DT,FY(XMIN+I*DT)) 10 CONTINUE C C Case 2: find limits and scale plot; function values must be stored C in an array. C ELSE NN = MIN(N,MAXP) Y(0) = FY(XMIN) YMIN = Y(0) YMAX = Y(0) DO 20 I=1,NN Y(I) = FY(XMIN+DT*I) YMIN = MIN(YMIN,Y(I)) YMAX = MAX(YMAX,Y(I)) 20 CONTINUE DY = 0.05*(YMAX-YMIN) IF (DY.EQ.0.0) THEN YMIN = YMIN - 1.0 YMAX = YMAX + 1.0 ELSE YMIN = YMIN - DY YMAX = YMAX + DY END IF CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0) CALL PGMOVE(XMIN,Y(0)) DO 30 I=1,NN CALL PGDRAW(XMIN+DT*I,Y(I)) 30 CONTINUE END IF C CALL PGEBUF END efined by the equation Y = FY(X), where FY is a C user-supplied subroutine. C C Arguments: C FY (external real function): supplied by the user, evaluates C Y value at a given X-coordinate. C N (input) : the number of points required to define the C curve. Tpgplot/src/pgfuny.f010064400040640000322000000047510555255506100150170ustar00tjpcitmbr00000400000017C*PGFUNY -- function defined by X = F(Y) C+ SUBROUTINE PGFUNY (FX, N, YMIN, YMAX, PGFLAG) REAL FX EXTERNAL FX INTEGER N REAL YMIN, YMAX INTEGER PGFLAG C C Draw a curve defined by the equation X = FX(Y), where FY is a C user-supplied subroutine. C C Arguments: C FX (external real function): supplied by the user, evaluates C X value at a given Y-coordinate. C N (input) : the number of points required to define the C curve. The function FX will be called N+1 times. C If PGFLAG=0 and N is greater than 1000, 1000 C will be used instead. If N is less than 1, C nothing will be drawn. C YMIN (input) : the minimum value of Y. C YMAX (input) : the maximum value of Y. C PGFLAG (input) : if PGFLAG = 1, the curve is plotted in the C current window and viewport; if PGFLAG = 0, C PGENV is called automatically by PGFUNY to C start a new plot with Y limits (YMIN, YMAX) C and automatic scaling in X. C C Note: The function FX must be declared EXTERNAL in the Fortran C program unit that calls PGFUNY. It has one argument, the C y-coordinate at which the x value is required, e.g. C REAL FUNCTION FX(Y) C REAL Y C FX = ..... C END C-- C 5-Oct-1983 C 11-May-1990 - remove unnecessary include [TJP]. C 13-DEc-1990 - make errors non-fatal [TJP]. C----------------------------------------------------------------------- INTEGER MAXP PARAMETER (MAXP=1000) INTEGER I REAL X(0:MAXP), Y(0:MAXP), DT REAL XMIN, XMAX C IF (N.LT.1 .OR. N.GT.MAXP) THEN CALL GRWARN('PGFUNY: invalid arguments') RETURN END IF CALL PGBBUF C C Evaluate function. C DT = (YMAX-YMIN)/N X(0) = FX(YMIN) Y(0) = YMIN XMIN = X(0) XMAX = X(0) DO 10 I=1,N X(I) = FX(YMIN+DT*I) Y(I) = YMIN + DT*I XMIN = MIN(XMIN,X(I)) XMAX = MAX(XMAX,X(I)) 10 CONTINUE DT = 0.05*(XMAX-XMIN) IF (DT.EQ.0.0) THEN XMIN = XMIN - 1.0 XMAX = XMAX + 1.0 ELSE XMIN = XMIN - DT XMAX = XMAX + DT END IF C C Define environment if necessary. C IF (PGFLAG.EQ.0) CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0) C C Draw curve. C CALL PGMOVE(X(0),Y(0)) DO 20 I=1,N CALL PGDRAW(X(I),Y(I)) 20 CONTINUE C CALL PGEBUF END pgplot/src/pghis1.f010064400040640000322000000031070555255506200146750ustar00tjpcitmbr00000400000017 REAL FUNCTION PGHIS1 (X, NELMX, CENTER, IXV) LOGICAL CENTER INTEGER NELMX, IXV REAL X(NELMX) C C PGPLOT Internal routine used by PGHI2D. Calculates the X-value for C the left hand edge of a given element of the array being plotted. C C Arguments - C C X (input, real array): abscissae of bins C NELMX (input, integer): number of bins C CENTER (Input, logical): if .true., X values denote the center of C the bin; if .false., the X values denote the lower edge (in X) C of the bin. C IXV (input, integer): the bin number in question. Note IXV may be C outside the range 1..NELMX, in which case an interpolated C value is returned. C C 21-Feb-1984 - Keith Shortridge. C 6-Sep-1989 - Changes for standard Fortran-77 [TJP]. C----------------------------------------------------------------------- REAL XN INTRINSIC REAL C IF (CENTER) THEN IF ((IXV.GT.1).AND.(IXV.LE.NELMX)) THEN XN = ( X(IXV-1) + X(IXV) ) * .5 ELSE IF (IXV.LE.1) THEN XN = X(1) - .5 * (X(2) - X(1)) * REAL(3 - 2 * IXV) ELSE IF (IXV.GT.NELMX) THEN XN = X(NELMX) +.5*(X(NELMX)-X(NELMX-1))* 1 REAL((IXV-NELMX)*2-1) END IF ELSE IF ((IXV.GE.1).AND.(IXV.LE.NELMX)) THEN XN = X(IXV) ELSE IF (IXV.LT.1) THEN XN = X(1) - ( X(2) - X(1) ) * REAL( 1 - IXV ) ELSE IF (IXV.GT.NELMX) THEN XN = X(NELMX) + ( X(NELMX) - X(NELMX-1)) * 1 REAL(IXV - NELMX) END IF END IF C PGHIS1 = XN END pgplot/src/pghist.f010064400040640000322000000113230613406371400147720ustar00tjpcitmbr00000400000017C*PGHIST -- histogram of unbinned data C%void cpghist(int n, const float *data, float datmin, float datmax, \ C% int nbin, int pgflag); C+ SUBROUTINE PGHIST(N, DATA, DATMIN, DATMAX, NBIN, PGFLAG) INTEGER N REAL DATA(*) REAL DATMIN, DATMAX INTEGER NBIN, PGFLAG C C Draw a histogram of N values of a variable in array C DATA(1...N) in the range DATMIN to DATMAX using NBIN bins. Note C that array elements which fall exactly on the boundary between C two bins will be counted in the higher bin rather than the C lower one; and array elements whose value is less than DATMIN or C greater than or equal to DATMAX will not be counted at all. C C Arguments: C N (input) : the number of data values. C DATA (input) : the data values. Note: the dimension of array C DATA must be greater than or equal to N. The C first N elements of the array are used. C DATMIN (input) : the minimum data value for the histogram. C DATMAX (input) : the maximum data value for the histogram. C NBIN (input) : the number of bins to use: the range DATMIN to C DATMAX is divided into NBIN equal bins and C the number of DATA values in each bin is C determined by PGHIST. NBIN may not exceed 200. C PGFLAG (input) : if PGFLAG = 1, the histogram is plotted in the C current window and viewport; if PGFLAG = 0, C PGENV is called automatically by PGHIST to start C a new plot (the x-limits of the window will be C DATMIN and DATMAX; the y-limits will be chosen C automatically. C IF PGFLAG = 2,3 the histogram will be in the same C window and viewport but with a filled area style. C If pgflag=4,5 as for pgflag = 0,1, but simple C line drawn as for PGBIN C C-- C Side effects: C C The pen position is changed to (DATMAX,0.0) in world coordinates. C-- C 6-Sep-83: C 11-Feb-92: fill options added. C----------------------------------------------------------------------- INTEGER MAXBIN PARAMETER (MAXBIN=200) INTEGER I, IBIN, NUM(MAXBIN), NUMMAX, JUNK REAL BINSIZ, PGRND REAL CUR, PREV, XLO, XHI, YLO, YHI LOGICAL PGNOTO C IF (N.LT.1 .OR. DATMAX.LE.DATMIN .OR. NBIN.LT.1 .OR. 1 NBIN.GT.MAXBIN) THEN CALL GRWARN('PGHIST: invalid arguments') RETURN END IF IF (PGNOTO('PGHIST')) RETURN CALL PGBBUF C C How many values in each bin? C DO 10 IBIN=1,NBIN NUM(IBIN) = 0 10 CONTINUE DO 20 I=1,N IBIN = (DATA(I)-DATMIN)/(DATMAX-DATMIN)*NBIN+1 IF (IBIN.GE.1 .AND. IBIN.LE.NBIN) NUM(IBIN) = NUM(IBIN)+1 20 CONTINUE NUMMAX = 0 DO 30 IBIN=1,NBIN NUMMAX = MAX(NUMMAX,NUM(IBIN)) 30 CONTINUE BINSIZ = (DATMAX-DATMIN)/NBIN C C Boundaries of plot. C XLO = DATMIN XHI = DATMAX YLO = 0.0 YHI = PGRND(1.01*NUMMAX,JUNK) C C Define environment if necessary. C IF (MOD(PGFLAG,2).EQ.0) THEN CALL PGENV(XLO,XHI,YLO,YHI,0,0) END IF C C Draw Histogram. C IF (PGFLAG/2.EQ.0) THEN PREV = 0.0 XHI=DATMIN CALL GRMOVA(DATMIN,0.0) DO 40 IBIN=1,NBIN CUR = NUM(IBIN) XLO=XHI XHI = DATMIN + IBIN*BINSIZ IF (CUR.EQ.0.0) THEN CONTINUE ELSE IF (CUR.LE.PREV) THEN CALL GRMOVA(XLO,CUR) CALL GRLINA(XHI,CUR) ELSE CALL GRMOVA(XLO,PREV) CALL GRLINA(XLO,CUR) CALL GRLINA(XHI,CUR) END IF CALL GRLINA(XHI,0.0) PREV = CUR 40 CONTINUE ELSE IF (PGFLAG/2.EQ.1) THEN PREV = 0.0 XHI = DATMIN DO 50 IBIN=1,NBIN CUR = NUM(IBIN) XLO=XHI XHI = DATMIN + IBIN*BINSIZ IF (CUR.EQ.0.0) THEN CONTINUE ELSE CALL PGRECT(XLO,XHI,0.0,CUR) END IF 50 CONTINUE ELSE IF (PGFLAG/2.EQ.2) THEN PREV = 0.0 CALL GRMOVA(DATMIN,0.0) XHI=DATMIN DO 60 IBIN=1,NBIN CUR = NUM(IBIN) XLO = XHI XHI = DATMIN + IBIN*BINSIZ IF (CUR.EQ.0.0 .AND. PREV.EQ.0.0) THEN CALL GRMOVA(XHI,0.0) ELSE CALL GRLINA(XLO,CUR) IF(CUR.NE.0.0) THEN CALL GRLINA(XHI,CUR) ELSE CALL GRMOVA(XHI,CUR) ENDIF END IF PREV = CUR 60 CONTINUE END IF C CALL PGEBUF END in each bin is C determined by PGHIST. NBIN may not exceed 200. C PGFLAG (input) : if PGFLAG = 1, the histogram is plotted in the C current window and viewport; if PGFLAG = 0, C PGENV is called automatically by PGHIST to start C pgplot/src/pglab.f010064400040640000322000000017310613406371500145640ustar00tjpcitmbr00000400000017C*PGLAB -- write labels for x-axis, y-axis, and top of plot C%void cpglab(const char *xlbl, const char *ylbl, const char *toplbl); C+ SUBROUTINE PGLAB (XLBL, YLBL, TOPLBL) CHARACTER*(*) XLBL, YLBL, TOPLBL C C Write labels outside the viewport. This routine is a simple C interface to PGMTXT, which should be used if PGLAB is inadequate. C C Arguments: C XLBL (input) : a label for the x-axis (centered below the C viewport). C YLBL (input) : a label for the y-axis (centered to the left C of the viewport, drawn vertically). C TOPLBL (input) : a label for the entire plot (centered above the C viewport). C-- C 11-May-1990 - remove unnecessary include - TJP. C----------------------------------------------------------------------- CALL PGBBUF CALL PGMTXT('T', 2.0, 0.5, 0.5, TOPLBL) CALL PGMTXT('B', 3.2, 0.5, 0.5, XLBL) CALL PGMTXT('L', 2.2, 0.5, 0.5, YLBL) CALL PGEBUF END pgplot/src/pgmove.f010064400040640000322000000007750555255506300150100ustar00tjpcitmbr00000400000017C*PGMOVE -- move pen (change current pen position) C%void cpgmove(float x, float y); C+ SUBROUTINE PGMOVE (X, Y) REAL X, Y C C Primitive routine to move the "pen" to the point with world C coordinates (X,Y). No line is drawn. C C Arguments: C X (input) : world x-coordinate of the new pen position. C Y (input) : world y-coordinate of the new pen position. C-- C (29-Dec-1983) C----------------------------------------------------------------------- CALL GRMOVA(X,Y) END pgplot/src/pgnpl.f010064400040640000322000000017370555255506400146330ustar00tjpcitmbr00000400000017 C C.PGNPL -- Work out how many numerals there are in an integer C. SUBROUTINE PGNPL (NMAX, N, NPL) C INTEGER NMAX, N, NPL C C Work out how many numerals there are in an integer for use with C format statements. C e.g. N=280 => NPL=3, N=-3 => NPL=2 C C Input: C NMAX : If > 0, issue a warning that N is going to C exceed the format statement field size if NPL C exceeds NMAX C N : Integer of interest C Output: C NPL : Number of numerals C C- C 20-Apr-1991 -- new routine (Neil Killeen) C------------------------------------------------------------------------- IF (N.EQ.0) THEN NPL = 1 ELSE NPL = INT(LOG10(REAL(ABS(N)))) + 1 END IF IF (N.LT.0) NPL = NPL + 1 C IF (NMAX.GT.0 .AND. NPL.GT.NMAX) * CALL GRWARN ('PGNPL: output conversion error likely; ' * //'number too big for format') C RETURN END pgplot/src/pgpixl.f010064400040640000322000000045610613406372100150030ustar00tjpcitmbr00000400000017C*PGPIXL -- draw pixels C%void cpgpixl(const int *ia, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float x1, float x2, float y1, float y2); C+ SUBROUTINE PGPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 1 X1, X2, Y1, Y2) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL X1, X2, Y1, Y2 C C Draw lots of solid-filled (tiny) rectangles aligned with the C coordinate axes. Best performance is achieved when output is C directed to a pixel-oriented device and the rectangles coincide C with the pixels on the device. In other cases, pixel output is C emulated. C C The subsection of the array IA defined by indices (I1:I2, J1:J2) C is mapped onto world-coordinate rectangle defined by X1, X2, Y1 C and Y2. This rectangle is divided into (I2 - I1 + 1) * (J2 - J1 + 1) C small rectangles. Each of these small rectangles is solid-filled C with the color index specified by the corresponding element of C IA. C C On most devices, the output region is "opaque", i.e., it obscures C all graphical elements previously drawn in the region. But on C devices that do not have erase capability, the background shade C is "transparent" and allows previously-drawn graphics to show C through. C C Arguments: C IA (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C X1, Y1 (input) : world coordinates of one corner of the output C region C X2, Y2 (input) : world coordinates of the opposite corner of the C output region C-- C 16-Jan-1991 - [GvG] C----------------------------------------------------------------------- LOGICAL PGNOTO C C Check inputs. C IF (PGNOTO('PGPIXL')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GT.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GT.J2) THEN CALL GRWARN('PGPIXL: invalid range I1:I2, J1:J2') ELSE C C Call lower-level routine to do the work. C CALL PGBBUF CALL GRPIXL(IA, IDIM, JDIM, I1, I2, J1, J2, X1, X2, Y1, Y2) CALL PGEBUF END IF C----------------------------------------------------------------------- END pgplot/src/pgpt.f010064400040640000322000000040210631236301500144360ustar00tjpcitmbr00000400000017C*PGPT -- draw several graph markers C%void cpgpt(int n, const float *xpts, const float *ypts, int symbol); C+ SUBROUTINE PGPT (N, XPTS, YPTS, SYMBOL) INTEGER N REAL XPTS(*), YPTS(*) INTEGER SYMBOL C C Primitive routine to draw Graph Markers (polymarker). The markers C are drawn using the current values of attributes color-index, C line-width, and character-height (character-font applies if the symbol C number is >31). If the point to be marked lies outside the window, C no marker is drawn. The "pen position" is changed to C (XPTS(N),YPTS(N)) in world coordinates (if N > 0). C C Arguments: C N (input) : number of points to mark. C XPTS (input) : world x-coordinates of the points. C YPTS (input) : world y-coordinates of the points. C SYMBOL (input) : code number of the symbol to be drawn at each C point: C -1, -2 : a single dot (diameter = current C line width). C -3..-31 : a regular polygon with ABS(SYMBOL) C edges (style set by current fill style). C 0..31 : standard marker symbols. C 32..127 : ASCII characters (in current font). C e.g. to use letter F as a marker, let C SYMBOL = ICHAR('F'). C > 127 : a Hershey symbol number. C C Note: the dimension of arrays X and Y must be greater than or equal C to N. If N is 1, X and Y may be scalars (constants or variables). If C N is less than 1, nothing is drawn. C-- C 27-Nov-1986 C 17-Dec-1990 - add polygons [PAH]. C 14-Mar-1997 - optimization: use GRDOT1 [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (N.LT.1) RETURN IF (PGNOTO('PGPT')) RETURN C CALL PGBBUF IF (SYMBOL.GE.0 .OR. SYMBOL.LE.-3) THEN CALL GRMKER(SYMBOL,.FALSE.,N,XPTS,YPTS) ELSE CALL GRDOT1(N,XPTS,YPTS) END IF CALL PGEBUF END pgplot/src/pgqcol.f010064400040640000322000000013510555255506600147720ustar00tjpcitmbr00000400000017C*PGQCOL -- inquire color capability C%void cpgqcol(int *ci1, int *ci2); C+ SUBROUTINE PGQCOL (CI1, CI2) INTEGER CI1, CI2 C C Query the range of color indices available on the current device. C C Argument: C CI1 (output) : the minimum available color index. This will be C either 0 if the device can write in the C background color, or 1 if not. C CI2 (output) : the maximum available color index. This will be C 1 if the device has no color capability, or a C larger number (e.g., 3, 7, 15, 255). C-- C 31-May-1989 - new routine [TJP]. C----------------------------------------------------------------------- CALL GRQCOL(CI1, CI2) END pgplot/src/pgqcr.f010064400040640000322000000010400555255506600146140ustar00tjpcitmbr00000400000017C*PGQCR -- inquire color representation C%void cpgqcr(int ci, float *cr, float *cg, float *cb); C+ SUBROUTINE PGQCR (CI, CR, CG, CB) INTEGER CI REAL CR, CG, CB C C Query the RGB colors associated with a color index. C C Arguments: C CI (input) : color index C CR (output) : red, green and blue intensities C CG (output) in the range 0.0 to 1.0 C CB (output) C-- C 7-Apr-1992 - new routine [DLT] C----------------------------------------------------------------------- CALL GRQCR(CI, CR, CG, CB) END pgplot/src/pgqpos.f010064400040640000322000000007350555255506600150230ustar00tjpcitmbr00000400000017C*PGQPOS -- inquire current pen position C%void cpgqpos(float *x, float *y); C+ SUBROUTINE PGQPOS (X, Y) REAL X, Y C C Query the current "pen" position in world C coordinates (X,Y). C C Arguments: C X (output) : world x-coordinate of the pen position. C Y (output) : world y-coordinate of the pen position. C-- C 1-Mar-1991 - new routine [JM]. C----------------------------------------------------------------------- CALL GRQPOS(X,Y) END pgplot/src/pgrnd.f010064400040640000322000000026210555255506700146210ustar00tjpcitmbr00000400000017C*PGRND -- find the smallest `round' number greater than x C%float cpgrnd(float x, int *nsub); C+ REAL FUNCTION PGRND (X, NSUB) REAL X INTEGER NSUB C C Routine to find the smallest "round" number larger than x, a C "round" number being 1, 2 or 5 times a power of 10. If X is negative, C PGRND(X) = -PGRND(ABS(X)). eg PGRND(8.7) = 10.0, C PGRND(-0.4) = -0.5. If X is zero, the value returned is zero. C This routine is used by PGBOX for choosing tick intervals. C C Returns: C PGRND : the "round" number. C Arguments: C X (input) : the number to be rounded. C NSUB (output) : a suitable number of subdivisions for C subdividing the "nice" number: 2 or 5. C-- C 6-Sep-1989 - Changes for standard Fortran-77 [TJP]. C 2-Dec-1991 - Fix for bug found on Fujitsu [TJP]. C----------------------------------------------------------------------- INTEGER I,ILOG REAL FRAC,NICE(3),PWR,XLOG,XX INTRINSIC ABS, LOG10, SIGN DATA NICE/2.0,5.0,10.0/ C IF (X.EQ.0.0) THEN PGRND = 0.0 NSUB = 2 RETURN END IF XX = ABS(X) XLOG = LOG10(XX) ILOG = XLOG IF (XLOG.LT.0) ILOG=ILOG-1 PWR = 10.0**ILOG FRAC = XX/PWR I = 3 IF (FRAC.LE.NICE(2)) I = 2 IF (FRAC.LE.NICE(1)) I = 1 PGRND = SIGN(PWR*NICE(I),X) NSUB = 5 IF (I.EQ.1) NSUB = 2 END pgplot/src/pgrnge.f010064400040640000322000000014010567363147400147650ustar00tjpcitmbr00000400000017C*PGRNGE -- choose axis limits C%void cpgrnge(float x1, float x2, float *xlo, float *xhi); C+ SUBROUTINE PGRNGE (X1, X2, XLO, XHI) REAL X1, X2, XLO, XHI C C Choose plotting limits XLO and XHI which encompass the data C range X1 to X2. C C Arguments: C X1, X2 (input) : the data range (X1= X2). C-- C 10-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- XLO = X1 - 0.1*(X2-X1) XHI = X2 + 0.1*(X2-X1) IF (XLO.LT.0.0 .AND. X1.GE.0.0) XLO = 0.0 IF (XHI.GT.0.0 .AND. X2.LE.0.0) XHI = 0.0 END pgplot/src/pgsave.f010064400040640000322000000063160630543426000147650ustar00tjpcitmbr00000400000017C*PGSAVE -- save PGPLOT attributes C%void cpgsave(void); C+ SUBROUTINE PGSAVE C C This routine saves the current PGPLOT attributes in a private storage C area. They can be restored by calling PGUNSA (unsave). Attributes C saved are: character font, character height, color index, fill-area C style, line style, line width, pen position, arrow-head style, C hatching style, and clipping state. Color representation is not saved. C C Calls to PGSAVE and PGUNSA should always be paired. Up to 20 copies C of the attributes may be saved. PGUNSA always retrieves the last-saved C values (last-in first-out stack). C C Note that when multiple devices are in use, PGUNSA retrieves the C values saved by the last PGSAVE call, even if they were for a C different device. C C Arguments: none C-- C 20-Apr-1992 - new routine [TJP]. C 27-Nov-1992 - add arrowhead style [TJP]. C 6-Oct-1993 - add text opacity [TJP]. C 28-Feb-1994 - correct bug (variable not saved) [TJP]. C 26-Feb-1995 - add hatching attributes. C 19-Jun-1996 - correction in header comments [TJP]. C 26-Feb-1997 - add clipping state [TJP]. C----------------------------------------------------------------------- INTEGER MAXS PARAMETER (MAXS=20) C INTEGER LEV INTEGER CF(MAXS), CI(MAXS), FS(MAXS), LS(MAXS), LW(MAXS) INTEGER AHFS(MAXS), TBG(MAXS), CLP(MAXS) REAL CH(MAXS), POS(2,MAXS) REAL AHANG(MAXS), AHBARB(MAXS), HSA(MAXS), HSS(MAXS), HSP(MAXS) SAVE LEV, CF, CI, FS, LS, LW, AHFS, TBG, CH, POS SAVE AHANG, AHBARB, HSA, HSS, HSP, CLP DATA LEV /0/ C IF (LEV.GE.MAXS) THEN CALL GRWARN('Too many unmatched calls to PGSAVE') ELSE LEV = LEV+1 CALL PGQCF(CF(LEV)) CALL PGQCH(CH(LEV)) CALL PGQCI(CI(LEV)) CALL PGQFS(FS(LEV)) CALL PGQLS(LS(LEV)) CALL PGQLW(LW(LEV)) C CALL PGQVP(0, VP(1,LEV), VP(2,LEV), VP(3,LEV), VP(4,LEV)) C CALL PGQWIN(WIN(1,LEV), WIN(2,LEV), WIN(3,LEV), WIN(4,LEV)) CALL PGQPOS(POS(1,LEV), POS(2,LEV)) CALL PGQAH(AHFS(LEV), AHANG(LEV), AHBARB(LEV)) CALL PGQTBG(TBG(LEV)) CALL PGQHS(HSA(LEV), HSS(LEV), HSP(LEV)) CALL PGQCLP(CLP(LEV)) END IF RETURN C C*PGUNSA -- restore PGPLOT attributes C%void cpgunsa(void); C+ ENTRY PGUNSA C C This routine restores the PGPLOT attributes saved in the last call to C PGSAVE. Usage: CALL PGUNSA (no arguments). See PGSAVE. C C Arguments: none C----------------------------------------------------------------------- IF (LEV.LE.0) THEN CALL GRWARN('PGUNSA: nothing has been saved') ELSE CALL PGSCF(CF(LEV)) CALL PGSCH(CH(LEV)) CALL PGSCI(CI(LEV)) CALL PGSFS(FS(LEV)) CALL PGSLS(LS(LEV)) CALL PGSLW(LW(LEV)) C CALL PGSVP(VP(1,LEV), VP(2,LEV), VP(3,LEV), VP(4,LEV)) C CALL PGSWIN(WIN(1,LEV), WIN(2,LEV), WIN(3,LEV), WIN(4,LEV)) CALL PGMOVE(POS(1,LEV), POS(2,LEV)) CALL PGSAH(AHFS(LEV), AHANG(LEV), AHBARB(LEV)) CALL PGSTBG(TBG(LEV)) CALL PGSHS(HSA(LEV), HSS(LEV), HSP(LEV)) CALL PGSCLP(CLP(LEV)) LEV = LEV-1 END IF RETURN END pgplot/src/pgscrn.f010064400040640000322000000104230613406372500147720ustar00tjpcitmbr00000400000017C*PGSCRN -- set color representation by name C%void cpgscrn(int ci, const char *name, int *ier); C+ SUBROUTINE PGSCRN(CI, NAME, IER) INTEGER CI CHARACTER*(*) NAME INTEGER IER C C Set color representation: i.e., define the color to be C associated with a color index. Ignored for devices which do not C support variable color or intensity. This is an alternative to C routine PGSCR. The color representation is defined by name instead C of (R,G,B) components. C C Color names are defined in an external file which is read the first C time that PGSCRN is called. The name of the external file is C found as follows: C 1. if environment variable (logical name) PGPLOT_RGB is defined, C its value is used as the file name; C 2. otherwise, if environment variable PGPLOT_DIR is defined, a C file "rgb.txt" in the directory named by this environment C variable is used; C 3. otherwise, file "rgb.txt" in the current directory is used. C If all of these fail to find a file, an error is reported and C the routine does nothing. C C Each line of the file C defines one color, with four blank- or tab-separated fields per C line. The first three fields are the R, G, B components, which C are integers in the range 0 (zero intensity) to 255 (maximum C intensity). The fourth field is the color name. The color name C may include embedded blanks. Example: C C 255 0 0 red C 255 105 180 hot pink C 255 255 255 white C 0 0 0 black C C Arguments: C CI (input) : the color index to be defined, in the range 0-max. C If the color index greater than the device C maximum is specified, the call is ignored. Color C index 0 applies to the background color. C NAME (input) : the name of the color to be associated with C this color index. This name must be in the C external file. The names are not case-sensitive. C If the color is not listed in the file, the C color representation is not changed. C IER (output) : returns 0 if the routine was successful, 1 C if an error occurred (either the external file C could not be read, or the requested color was C not defined in the file). C-- C 12-Oct-1992 [TJP] C 31-May-1993 [TJP] use GROPTX to open file. C 7-Nov-1994 [TJP] better error messages. C----------------------------------------------------------------------- INTEGER MAXCOL PARAMETER (MAXCOL=1000) INTEGER I, IR, IG, IB, J, L, NCOL, UNIT, IOS INTEGER GRCTOI, GROPTX, GRTRIM REAL RR(MAXCOL), RG(MAXCOL), RB(MAXCOL) CHARACTER*20 CREQ, CNAME(MAXCOL) CHARACTER*255 TEXT SAVE NCOL, CNAME, RR, RG, RB DATA NCOL/0/ C C On first call, read the database. C IF (NCOL.EQ.0) THEN CALL GRGFIL('RGB', TEXT) L = GRTRIM(TEXT) IF (L.LT.1) L = 1 CALL GRGLUN(UNIT) IOS = GROPTX(UNIT, TEXT(1:L), 'rgb.txt', 0) IF (IOS.NE.0) GOTO 40 DO 10 I=1,MAXCOL READ (UNIT, '(A)', ERR=15, END=15) TEXT J = 1 CALL GRSKPB(TEXT, J) IR = GRCTOI(TEXT, J) CALL GRSKPB(TEXT, J) IG = GRCTOI(TEXT, J) CALL GRSKPB(TEXT, J) IB = GRCTOI(TEXT, J) CALL GRSKPB(TEXT, J) NCOL = NCOL+1 CALL GRTOUP(CNAME(NCOL), TEXT(J:)) RR(NCOL) = IR/255.0 RG(NCOL) = IG/255.0 RB(NCOL) = IB/255.0 10 CONTINUE 15 CLOSE (UNIT) CALL GRFLUN(UNIT) END IF C C Look up requested color and set color representation if found. C CALL GRTOUP(CREQ, NAME) DO 20 I=1,NCOL IF (CREQ.EQ.CNAME(I)) THEN CALL PGSCR(CI, RR(I), RG(I), RB(I)) IER = 0 RETURN END IF 20 CONTINUE C C Color not found. C IER = 1 TEXT = 'Color not found: '//NAME CALL GRWARN(TEXT) RETURN C C Database not found. C 40 IER = 1 NCOL = -1 CALL GRFLUN(UNIT) CALL GRWARN('Unable to read color file: '//TEXT(1:L)) CALL GRWARN('Use environment variable PGPLOT_RGB to specify '// : 'the location of the PGPLOT rgb.txt file.') RETURN END pgplot/src/grchar.f010064400040640000322000000050670563344737500147660ustar00tjpcitmbr00000400000017C+ *********************************************************************** * * * PGPLOT Fortran Graphics Subroutine Library * * * * T. J. Pearson, California Institute of Technology, * * Pasadena, California 91125. * * * * Routines for handling the obsolete character set * * ------------------------------------------------ * * These routines are not called by PGPLOT but are called by some * * old user-written programs. * *********************************************************************** ******* Index of Modules ********************************************** * GRCHAR -- draw a string of characters * GRCHR0 -- support routine for GRCHAR and GRMARK * GRDAT2 -- character set definition (block data) * GRGTC0 -- obtain character digitization * GRMARK -- mark points with specified symbol *********************************************************************** C-- C*GRCHAR -- draw a string of characters C+ SUBROUTINE GRCHAR (IDENT,CENTER,ORIENT,ABSXY,X0,Y0,STRING) C C GRPCKG: Draw a string of characters. The plot is not windowed C in the current subarea, but in the full plotting area. C C Arguments: C C IDENT (input, integer): plot identifier, as returned by GROPEN. C CENTER (input, logical): if .TRUE., the first character of the string C is centered at (X0,Y0); otherwise the bottom left corner of the C first character is placed at (X0,Y0). C ORIENT (input, real): the angle in degrees that the string is to make C with the horizontal, increasing anticlockwise. C ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device C coordinates; otherwise they are world coordinates (the scaling C transformation is applied). C X0, Y0 (input, real): position of first character (see CENTER). C STRING (input, character): the string of ASCII characters; control C characters 0-20 have special representations; all other C non-graphic characters are plotted as blank spaces. C C (1-Feb-1983) C----------------------------------------------------------------------- CHARACTER*(*) STRING INTEGER IDENT LOGICAL ABSXY, CENTER REAL ORIENT, X0, Y0 C CALL GRSLCT(IDENT) CALL GRCHR0(.FALSE., CENTER, ORIENT, ABSXY, X0, Y0, STRING) RETURN END ) * GRGTC0 -- obtain character digitization * GRMARK -- mark points with specified symbol *********************************************************************** C-- C*GRCHAR -- draw a string of characters C+ SUBROUTINE GRCHAR (IDENT,CENTER,ORIENT,ABSXY,X0,Y0,STRING) C C GRPCKG: Draw a string of characters. The plot is not windowed C in the current subarea, but in the full plotting area. C C Arguments: C C IDENT (input, integer): plot identifierpgplot/src/pgshls.f010064400040640000322000000040540564262571400150060ustar00tjpcitmbr00000400000017C*PGSHLS -- set color representation using HLS system C%void cpgshls(int ci, float ch, float cl, float cs); C+ SUBROUTINE PGSHLS (CI, CH, CL, CS) INTEGER CI REAL CH, CL, CS C C Set color representation: i.e., define the color to be C associated with a color index. This routine is equivalent to C PGSCR, but the color is defined in the Hue-Lightness-Saturation C model instead of the Red-Green-Blue model. Hue is represented C by an angle in degrees, with red at 120, green at 240, C and blue at 0 (or 360). Lightness ranges from 0.0 to 1.0, with black C at lightness 0.0 and white at lightness 1.0. Saturation ranges from C 0.0 (gray) to 1.0 (pure color). Hue is irrelevant when saturation C is 0.0. C C Examples: H L S R G B C black any 0.0 0.0 0.0 0.0 0.0 C white any 1.0 0.0 1.0 1.0 1.0 C medium gray any 0.5 0.0 0.5 0.5 0.5 C red 120 0.5 1.0 1.0 0.0 0.0 C yellow 180 0.5 1.0 1.0 1.0 0.0 C pink 120 0.7 0.8 0.94 0.46 0.46 C C Reference: SIGGRAPH Status Report of the Graphic Standards Planning C Committee, Computer Graphics, Vol.13, No.3, Association for C Computing Machinery, New York, NY, 1979. See also: J. D. Foley et al, C ``Computer Graphics: Principles and Practice'', second edition, C Addison-Wesley, 1990, section 13.3.5. C C Argument: C CI (input) : the color index to be defined, in the range 0-max. C If the color index greater than the device C maximum is specified, the call is ignored. Color C index 0 applies to the background color. C CH (input) : hue, in range 0.0 to 360.0. C CL (input) : lightness, in range 0.0 to 1.0. C CS (input) : saturation, in range 0.0 to 1.0. C-- C 9-May-1988 - new routine [TJP]. C----------------------------------------------------------------------- REAL CR, CG, CB CALL GRXRGB (CH,CL,CS,CR,CG,CB) CALL GRSCR(CI,CR,CG,CB) END pgplot/src/grchr0.f010064400040640000322000000077500634733330400146730ustar00tjpcitmbr00000400000017C*GRCHR0 -- support routine for GRCHAR and GRMARK C+ SUBROUTINE GRCHR0 (WINDOW,CENTER,ORIENT,ABSXY,X0,Y0,STRING) C C GRPCKG (internal routine): Support routine for GRCHAR and GRMARK. C Draw a string of characters. C C Arguments: C C WINDOW (input, logical): if .TRUE., the plot is windowed in the C current window. C CENTER (input, logical): if .TRUE., the first character of the string C is centered at (X0,Y0); otherwise the bottom left corner of the C first character is placed at (X0,Y0). C ORIENT (input, real): the angle in degrees that the string is to make C with the horizontal, increasing anticlockwise. C ABSXY (input, logical): if .TRUE., (X0,Y0) are absolute device C coordinates; otherwise they are world coordinates (the scaling C transformation is applied). C X0, Y0 (input, real): position of first character (see CENTER). C STRING (input, character): the string of ASCII characters; control C characters 0-20 have special representations; all other C non-graphic characters are plotted as blank spaces. C C (1-Mar-1983) C----------------------------------------------------------------------- INTEGER DOT, MOVE, VECSIZ REAL PI PARAMETER (DOT = 3) PARAMETER (MOVE = 2) PARAMETER (VECSIZ = 30) PARAMETER (PI = 3.14159265359) INCLUDE 'grpckg1.inc' CHARACTER*(*) STRING CHARACTER*1 NEXT REAL XMIN, XMAX, YMIN, YMAX INTEGER MODE,LSTYLE,LEVEL INTEGER I, J, L, CH, POINTS LOGICAL ABSXY, CENTER, MORE, WINDOW REAL ORIENT, X0, Y0 REAL ANGLE, FACTOR, BASE, FAC REAL COSA, SINA REAL DX, DY, XORG, YORG REAL XC(VECSIZ), YC(VECSIZ), XT, YT C IF (LEN(STRING).LE.0) RETURN C C Compute scaling and orientation. C CALL GRQLS(LSTYLE) CALL GRSLS(1) ANGLE = (AMOD(ORIENT, 360.0) / 180.0) * PI FACTOR = GRCFAC(GRCIDE) COSA = FACTOR * COS(ANGLE) SINA = FACTOR * SIN(ANGLE) DX = 10.0 * COSA DY = 10.0 * SINA CALL GRTXY0(ABSXY, X0, Y0, XORG, YORG) IF (.NOT.WINDOW) THEN XMIN = GRXMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMIN = GRYMIN(GRCIDE) YMAX = GRYMAX(GRCIDE) CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0) END IF C C Plot the string of characters. C MODE = MOVE BASE = 0.0 FAC = 1.0 I = 1 LEVEL = 0 L = LEN(STRING) C -- DO WHILE (I.LE.L) 10 IF (I.LE.L) THEN IF (I.LT.L .AND. STRING(I:I).EQ.CHAR(92)) THEN CALL GRTOUP(NEXT,STRING(I+1:I+1)) IF (NEXT.EQ.'U') THEN LEVEL = LEVEL+1 BASE = BASE + 4.0*FAC FAC = 0.6**IABS(LEVEL) I = I+2 ELSE IF (NEXT.EQ.'D') THEN LEVEL = LEVEL-1 FAC = 0.6**IABS(LEVEL) BASE = BASE - 4.0*FAC I = I+2 ELSE I = I+1 END IF ELSE CH = ICHAR(STRING(I:I)) IF (CH.GT.127 .OR. CH.LT.0) CH = ICHAR(' ') MORE = .TRUE. C -- DO WHILE (MORE) 20 IF (MORE) THEN CALL GRGTC0(CH, CENTER, POINTS, XC, YC, MORE) DO 30 J=1,POINTS XT = XC(J)*FAC YT = YC(J)*FAC + BASE XC(J) = XORG + COSA * XT - SINA * YT YC(J) = YORG + SINA * XT + COSA * YT 30 CONTINUE IF (POINTS.EQ.1) MODE = DOT IF (POINTS.GT.0) CALL GRVCT0(MODE,.TRUE.,POINTS,XC,YC) IF (POINTS.EQ.1) MODE = MOVE GOTO 20 END IF C -- end DO WHILE XORG = XORG + DX*FAC YORG = YORG + DY*FAC I = I+1 END IF GOTO 10 END IF C -- end DO WHILE C C Clean up and return. C IF (.NOT.WINDOW) THEN GRXMIN(GRCIDE) = XMIN GRXMAX(GRCIDE) = XMAX GRYMIN(GRCIDE) = YMIN GRYMAX(GRCIDE) = YMAX END IF CALL GRSLS(LSTYLE) RETURN END pgplot/src/pgtext.f010064400040640000322000000013730613406372600150160ustar00tjpcitmbr00000400000017C*PGTEXT -- write text (horizontal, left-justified) C%void cpgtext(float x, float y, const char *text); C+ SUBROUTINE PGTEXT (X, Y, TEXT) REAL X, Y CHARACTER*(*) TEXT C C Write text. The bottom left corner of the first character is placed C at the specified position, and the text is written horizontally. C This is a simplified interface to the primitive routine PGPTXT. C For non-horizontal text, use PGPTXT. C C Arguments: C X (input) : world x-coordinate of start of string. C Y (input) : world y-coordinate of start of string. C TEXT (input) : the character string to be plotted. C-- C (2-May-1983) C----------------------------------------------------------------------- CALL PGPTXT(X, Y, 0.0, 0.0, TEXT) END laced C at the specified position, and the text is written horizontally. C This is a simplified interface to the primitive routine PGPTXT. C For non-horizontal text, use PGPTXT. C C Arguments: C X (input) : world x-coordinate of start of string. C Y pgplot/src/pgupdt.f010064400040640000322000000012160566573063600150130ustar00tjpcitmbr00000400000017C*PGUPDT -- update display C%void cpgupdt(void); C+ SUBROUTINE PGUPDT C C Update the graphics display: flush any pending commands to the C output device. This routine empties the buffer created by PGBBUF, C but it does not alter the PGBBUF/PGEBUF counter. The routine should C be called when it is essential that the display be completely up to C date (before interaction with the user, for example) but it is not C known if output is being buffered. C C Arguments: none C-- C 27-Nov-1986 C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGUPDT')) RETURN CALL GRTERM END pgplot/src/pgvect.f010064400040640000322000000105460622552702200147700ustar00tjpcitmbr00000400000017C*PGVECT -- vector map of a 2D data array, with blanking C%void cpgvect(const float *a, const float *b, int idim, int jdim, \ C% int i1, int i2, int j1, int j2, float c, int nc, \ C% const float *tr, float blank); C+ SUBROUTINE PGVECT (A, B, IDIM, JDIM, I1, I2, J1, J2, C, NC, TR, 1 BLANK) INTEGER IDIM, JDIM, I1, I2, J1, J2, NC REAL A(IDIM,JDIM), B(IDIM, JDIM), TR(6), BLANK, C C C Draw a vector map of two arrays. This routine is similar to C PGCONB in that array elements that have the "magic value" defined by C the argument BLANK are ignored, making gaps in the vector map. The C routine may be useful for data measured on most but not all of the C points of a grid. Vectors are displayed as arrows; the style of the C arrowhead can be set with routine PGSAH, and the the size of the C arrowhead is determined by the current character size, set by PGSCH. C C Arguments: C A (input) : horizontal component data array. C B (input) : vertical component data array. C IDIM (input) : first dimension of A and B. C JDIM (input) : second dimension of A and B. C I1,I2 (input) : range of first index to be mapped (inclusive). C J1,J2 (input) : range of second index to be mapped (inclusive). C C (input) : scale factor for vector lengths, if 0.0, C will be C set so that the longest vector is equal to the C smaller of TR(2)+TR(3) and TR(5)+TR(6). C NC (input) : vector positioning code. C <0 vector head positioned on coordinates C >0 vector base positioned on coordinates C =0 vector centered on the coordinates C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. The C world coordinates of the array point A(I,J) are C given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation C or shear. C BLANK (input) : elements of arrays A or B that are exactly equal to C this value are ignored (blanked). C-- C 4-Sep-1992: derived from PGCONB [J. Crane]. C 26-Nov-1992: revised to use PGARRO [TJP]. C 25-Mar-1994: correct error for NC not =0 [G. Gonczi]. C 5-Oct-1996: correct error in computing max vector length [TJP; C thanks to David Singleton]. C----------------------------------------------------------------------- INTEGER I, J REAL X, Y, X1, Y1, X2, Y2 REAL CC INTRINSIC SQRT, MAX, MIN C C Define grid to world transformation C X(I,J) = TR(1) + TR(2)*I + TR(3)*J Y(I,J) = TR(4) + TR(5)*I + TR(6)*J C C Check arguments. C IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) THEN C CALL GRWARN('PGVECT: invalid range I1:I2, J1:J2') RETURN END IF C C Check for scale factor C. C CC = C IF (CC.EQ.0.0) THEN DO 20 J=J1,J2 DO 10 I=I1,I2 IF (A(I,J).NE.BLANK .AND. B(I,J).NE.BLANK) 1 CC = MAX(CC,SQRT(A(I,J)**2+B(I,J)**2)) 10 CONTINUE 20 CONTINUE IF (CC.EQ.0.0) RETURN CC = SQRT(MIN(TR(2)**2+TR(3)**2,TR(5)**2+TR(6)**2))/CC END IF C CALL PGBBUF C DO 40 J=J1,J2 DO 30 I=I1,I2 C C Ignore vector if element of A and B are both equal to BLANK C IF (.NOT.(A(I,J).EQ.BLANK .AND. B(I,J).EQ.BLANK)) THEN C C Define the vector starting and end points according to NC. C IF (NC.LT.0) THEN X2 = X(I,J) Y2 = Y(I,J) X1 = X2 - A(I,J)*CC Y1 = Y2 - B(I,J)*CC ELSE IF (NC.EQ.0) THEN X2 = X(I,J) + 0.5*A(I,J)*CC Y2 = Y(I,J) + 0.5*B(I,J)*CC X1 = X2 - A(I,J)*CC Y1 = Y2 - B(I,J)*CC ELSE X1 = X(I,J) Y1 = Y(I,J) X2 = X1 + A(I,J)*CC Y2 = Y1 + B(I,J)*CC END IF C C Draw vector. C CALL PGARRO(X1, Y1, X2, Y2) END IF 30 CONTINUE 40 CONTINUE C CALL PGEBUF END pgplot/src/pgcnsc.f010064400040640000322000000140520605574103600147550ustar00tjpcitmbr00000400000017 SUBROUTINE PGCNSC (Z, MX, MY, IA, IB, JA, JB, Z0, PLOT) INTEGER MX, MY, IA, IB, JA, JB REAL Z(MX,*) REAL Z0 EXTERNAL PLOT C C PGPLOT (internal routine): Draw a single contour. This routine is C called by PGCONT, but may be called directly by the user. C C Arguments: C C Z (real array dimension MX,MY, input): the array of function values. C MX,MY (integer, input): actual declared dimension of Z(*,*). C IA,IB (integer, input): inclusive range of the first index of Z to be C contoured. C JA,JB (integer, input): inclusive range of the second index of Z to C be contoured. C Z0 (real, input): the contour level sought. C PLOT (the name of a subroutine declared EXTERNAL in the calling C routine): this routine is called by PGCNSC to do all graphical C output. The calling sequence is CALL PLOT(K,X,Y,Z) where Z is C the contour level, (X,Y) are the coordinates of a point (in the C inclusive range I131). If the point to be marked lies outside C the window, no marker is drawn. The "pen position" is changed to C (XPT,YPT) in world coordinates. C C To draw several markers with coordinates specified by X and Y C arrays, use routine PGPT. C C Arguments: C XPT (input) : world x-coordinate of the point. C YPT (input) : world y-coordinate of the point. C SYMBOL (input) : code number of the symbol to be drawn: C -1, -2 : a single dot (diameter = current C line width). C -3..-31 : a regular polygon with ABS(SYMBOL) C edges (style set by current fill style). C 0..31 : standard marker symbols. C 32..127 : ASCII characters (in current font). C e.g. to use letter F as a marker, let C SYMBOL = ICHAR('F'). C > 127 : a Hershey symbol number. C-- C 4-Feb-1997 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO REAL XPTS(1), YPTS(1) C IF (PGNOTO('PGPT1')) RETURN XPTS(1) = XPT YPTS(1) = YPT CALL PGPT(1, XPTS, YPTS, SYMBOL) END pgplot/src/grfa.f010064400040640000322000000117020613106243600144110ustar00tjpcitmbr00000400000017C*GRFA -- fill area (polygon) C+ SUBROUTINE GRFA (N,PX,PY) INTEGER N REAL PX(*), PY(*) C C GRPCKG: FILL AREA: fill a polygon with solid color. The polygon C is defined by the (x,y) world coordinates of its N vertices. If C this is not a function supported by the device, shading is C accomplished by drawing horizontal lines spaced by 1 pixel. By C selecting color index 0, the interior of the polygon can be erased C on devices which permit it. The polygon need not be convex, but if C it is re-entrant (i.e., edges intersect other than at the vertices), C it may not be obvious which regions are "inside" the polygon. The C following rule is applied: for a given point, create a straight line C starting at the point and going to infinity. If the number of C intersections between the straight line and the polygon is odd, the C point is within the polygon; otherwise it is outside. If the C straight line passes a polygon vertex tangentially, the C intersection count is not affected. The only attribute which applies C to FILL AREA is color index: line-width and line-style are ignored. C There is a limitation on the complexity of the polygon: GFA will C fail if any horizontal line intersects more than 32 edges of the C polygon. C C Arguments: C C N (input, integer): the number of vertices of the polygon (at least C 3). C PX, PY (input, real arrays, dimension at least N): world coordinates C of the N vertices of the polygon. C-- C 16-Jul-1984 - [TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - If needed, calls begin picture [AFT]. C 7-Sep-1994 - avoid driver call for capabilities [TJP]. C 1-May-1995 - fixed bug for re-entrant polygons, and optimized code C [A.F.Carman]. C 18-Oct-1995 - fixed bug: emulated fill failed for reversed y-axis C [S.C.Allendorf/TJP]. C 4-Dec-1995 - remove use of real variable as do-loop variable [TJP]. C 20-Mar-1996 - use another do loop 40 to avoid gaps between adjacent C polygons [RS] C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER MAXSEC PARAMETER (MAXSEC=32) INTEGER I, J, NSECT, LW, LS, NBUF, LCHR, LINE REAL RBUF(6) CHARACTER*32 CHR REAL X(MAXSEC), Y, YMIN, YMAX, DY, YD, TEMP, S1, S2, T1, T2 LOGICAL FORWD C IF (GRCIDE.LT.1) RETURN IF (N.LT.3) THEN CALL GRWARN('GRFA - polygon has < 3 vertices.') RETURN END IF C C Devices with polygon fill capability. C IF(GRGCAP(GRCIDE)(4:4).EQ.'A') THEN IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC RBUF(1) = N CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) DO 10 I=1,N RBUF(1) = PX(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE) RBUF(2) = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) 10 CONTINUE RETURN END IF C C For other devices fill area is simulated. C C Save attributes. C CALL GRQLS(LS) CALL GRQLW(LW) CALL GRSLS(1) CALL GRSLW(1) C C Find range of raster-lines to be shaded. C YMIN = PY(1)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) YMAX = YMIN DO 20 I=2,N YD = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) YMIN = MIN(YMIN,YD) YMAX = MAX(YMAX,YD) 20 CONTINUE CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR) DY = ABS(RBUF(3)) C C Find intersections of edges with current raster line. C FORWD = .TRUE. S1 = PX(N)*GRXSCL(GRCIDE) + GRXORG(GRCIDE) T1 = PY(N)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) C DO 40 LINE = NINT(YMIN/DY),NINT(YMAX/DY) Y = LINE * DY NSECT = 0 DO 30 I=1,N S2 = PX(I)*GRXSCL(GRCIDE) + GRXORG(GRCIDE) T2 = PY(I)*GRYSCL(GRCIDE) + GRYORG(GRCIDE) IF ((T1.LT.Y .AND. Y.LE.T2).OR. : (T1.GE.Y .AND. Y.GT.T2)) THEN NSECT = NSECT+1 IF (NSECT.GT.MAXSEC) THEN CALL GRWARN('GRFA - polygon is too complex.') RETURN END IF X(NSECT)=(S1+(S2-S1)*((Y-T1)/(T2-T1))) END IF S1 = S2 T1 = T2 30 CONTINUE C C Sort the intersections into increasing x order. C DO 34 I=2,NSECT DO 32 J=1,I IF (X(J).GT.X(I)) THEN TEMP = X(J) X(J) = X(I) X(I) = TEMP END IF 32 CONTINUE 34 CONTINUE C C Draw the horizontal line-segments. C GRYPRE(GRCIDE) = Y IF (FORWD) THEN DO 36 I=1,NSECT-1,2 GRXPRE(GRCIDE) = X(I) CALL GRLIN0(X(I+1),Y) 36 CONTINUE FORWD = .FALSE. ELSE DO 38 I=NSECT,2,-2 GRXPRE(GRCIDE) = X(I) CALL GRLIN0(X(I-1),Y) 38 CONTINUE FORWD = .TRUE. END IF 40 CONTINUE C C Restore attributes. C CALL GRSLS(LS) CALL GRSLW(LW) END een adjacent C polygons [RS] C------------------pgplot/src/grarea.f010064400040640000322000000025270566551145200147500ustar00tjpcitmbr00000400000017C*GRAREA -- define a clipping window C+ SUBROUTINE GRAREA (IDENT,X0,Y0,XSIZE,YSIZE) C C GRPCKG: Define a rectangular window in the current plotting area. All C graphics (except characters written with GRCHAR) will be blanked C outside this window. The default window is the full plotting area C defined by default or by GRSETS. C C Arguments: C C IDENT (input, integer): the plot identifier, returned by GROPEN. C X0, Y0 (input, real): the lower left corner of the window, in absolute C device coordinates. C XSIZE, YSIZE (input, real): width and height of the window in absolute C coordinates; if either is negative, the window will be reset to C the full plotting area. C-- C 1-Feb-1983 - [TJP]. C 25-Nov-1994 - use floating-point [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IDENT REAL X0, Y0, XSIZE, YSIZE C CALL GRSLCT(IDENT) C IF ((XSIZE.LE.0.0) .OR. (YSIZE.LE.0.0)) THEN GRXMIN(IDENT) = 0 GRXMAX(IDENT) = GRXMXA(IDENT) GRYMIN(IDENT) = 0 GRYMAX(IDENT) = GRYMXA(IDENT) ELSE GRXMIN(IDENT) = MAX(X0,0.0) GRYMIN(IDENT) = MAX(Y0,0.0) GRXMAX(IDENT) = MIN(XSIZE+X0,REAL(GRXMXA(IDENT))) GRYMAX(IDENT) = MIN(YSIZE+Y0,REAL(GRYMXA(IDENT))) END IF C END pgplot/src/grbpic.f010064400040640000322000000022570563345333600147560ustar00tjpcitmbr00000400000017C*GRBPIC -- begin picture C+ SUBROUTINE GRBPIC C C GRPCKG (internal routine). Send a "begin picture" command to the C device driver, and send commands to set deferred attributes (color, C line width, etc.) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(2) INTEGER NBUF, LCHR CHARACTER*20 CHR C GRPLTD(GRCIDE) = .TRUE. IF (GRGTYP.GT.0) THEN C -- begin picture RBUF(1) = GRXMXA(GRCIDE) RBUF(2) = GRYMXA(GRCIDE) NBUF = 2 CALL GREXEC(GRGTYP,11,RBUF,NBUF,CHR,LCHR) C -- set color index RBUF(1) = GRCCOL(GRCIDE) NBUF = 1 CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR) C -- set line width IF (GRGCAP(GRCIDE)(5:5).EQ.'T') THEN RBUF(1) = ABS(GRWIDT(GRCIDE)) NBUF = 1 CALL GREXEC(GRGTYP,22,RBUF,NBUF,CHR,LCHR) END IF C -- set hardware dashing IF (GRGCAP(GRCIDE)(3:3).EQ.'D') THEN RBUF(1) = GRSTYL(GRCIDE) NBUF = 1 CALL GREXEC(GRGTYP,19,RBUF,NBUF,CHR,LCHR) END IF END IF C END pgplot/src/grdat2.f010064400040640000322000000714460546005546600147010ustar00tjpcitmbr00000400000017 C*GRDAT2 -- character set definition (block data) C+ BLOCK DATA GRDAT2 C C GRPCKG (internal routine): Block data for to define the character set. C C Arguments: none. C C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER CTD1, CTD2 PARAMETER (CTD1 = 30) PARAMETER (CTD2 = 128) C INTEGER CINDX1, CINDX2 INTEGER CHTBL(CTD1,CTD2) INTEGER SPCH00(CTD1), SPCH01(CTD1), SPCH02(CTD1), SPCH03(CTD1) 1 , SPCH04(CTD1), SPCH05(CTD1), SPCH06(CTD1), SPCH07(CTD1) 2 , SPCH08(CTD1), SPCH09(CTD1), SPCH10(CTD1), SPCH11(CTD1) 3 , SPCH12(CTD1), SPCH13(CTD1), SPCH14(CTD1), SPCH15(CTD1) 4 , SPCH16(CTD1), SPCH17(CTD1), SPCH18(CTD1), SPCH19(CTD1) 5 , SPCH20(CTD1), SPCH21(CTD1), SPCH22(CTD1), SPCH23(CTD1) 6 , SPCH24(CTD1), SPCH25(CTD1), SPCH26(CTD1), SPCH27(CTD1) 7 , SPCH28(CTD1), SPCH29(CTD1), SPCH30(CTD1), SPCH31(CTD1) 8 , SPACE (CTD1), EXCLAM(CTD1), QUOTE (CTD1), POUND (CTD1) 9 , DOLLAR(CTD1), PERCNT(CTD1), AMPERS(CTD1), APOSTR(CTD1) A , LPAREN(CTD1), RPAREN(CTD1), ASTER (CTD1), PLUS (CTD1) B , COMMA (CTD1), MINUS (CTD1), PERIOD(CTD1), SLASH (CTD1) C , ZERO (CTD1), ONE (CTD1), TWO (CTD1), THREE (CTD1) D , FOUR (CTD1), FIVE (CTD1), SIX (CTD1), SEVEN (CTD1) E , EIGHT (CTD1), NINE (CTD1), COLON (CTD1), SEMICO(CTD1) F , LESS (CTD1), EQUALS(CTD1), GREATR(CTD1), QUESTN(CTD1) INTEGER ATSIGN(CTD1), AUPPER(CTD1), BUPPER(CTD1), CUPPER(CTD1) 1 , DUPPER(CTD1), EUPPER(CTD1), FUPPER(CTD1), GUPPER(CTD1) 2 , HUPPER(CTD1), IUPPER(CTD1), JUPPER(CTD1), KUPPER(CTD1) 3 , LUPPER(CTD1), MUPPER(CTD1), NUPPER(CTD1), OUPPER(CTD1) 4 , PUPPER(CTD1), QUPPER(CTD1), RUPPER(CTD1), SUPPER(CTD1) 5 , TUPPER(CTD1), UUPPER(CTD1), VUPPER(CTD1), WUPPER(CTD1) 6 , XUPPER(CTD1), YUPPER(CTD1), ZUPPER(CTD1), LBRACK(CTD1) 7 , BKSLSH(CTD1), RBRACK(CTD1), CARET (CTD1), USCORE(CTD1) 8 , ACCENT(CTD1), ALOWER(CTD1), BLOWER(CTD1), CLOWER(CTD1) 9 , DLOWER(CTD1), ELOWER(CTD1), FLOWER(CTD1), GLOWER(CTD1) A , HLOWER(CTD1), ILOWER(CTD1), JLOWER(CTD1), KLOWER(CTD1) B , LLOWER(CTD1), MLOWER(CTD1), NLOWER(CTD1), OLOWER(CTD1) C , PLOWER(CTD1), QLOWER(CTD1), RLOWER(CTD1), SLOWER(CTD1) D , TLOWER(CTD1), ULOWER(CTD1), VLOWER(CTD1), WLOWER(CTD1) E , XLOWER(CTD1), YLOWER(CTD1), ZLOWER(CTD1), LBRACE(CTD1) F , ORSIGN(CTD1), RBRACE(CTD1), TILDE (CTD1), SPC127(CTD1) EQUIVALENCE (SPCH00, CHTBL(1, 1)), (SPCH01, CHTBL(1, 2)) 1 , (SPCH02, CHTBL(1, 3)), (SPCH03, CHTBL(1, 4)) 2 , (SPCH04, CHTBL(1, 5)), (SPCH05, CHTBL(1, 6)) 3 , (SPCH06, CHTBL(1, 7)), (SPCH07, CHTBL(1, 8)) 4 , (SPCH08, CHTBL(1, 9)), (SPCH09, CHTBL(1, 10)) 5 , (SPCH10, CHTBL(1, 11)), (SPCH11, CHTBL(1, 12)) 6 , (SPCH12, CHTBL(1, 13)), (SPCH13, CHTBL(1, 14)) 7 , (SPCH14, CHTBL(1, 15)), (SPCH15, CHTBL(1, 16)) 8 , (SPCH16, CHTBL(1, 17)), (SPCH17, CHTBL(1, 18)) 9 , (SPCH18, CHTBL(1, 19)), (SPCH19, CHTBL(1, 20)) A , (SPCH20, CHTBL(1, 21)), (SPCH21, CHTBL(1, 22)) B , (SPCH22, CHTBL(1, 23)), (SPCH23, CHTBL(1, 24)) C , (SPCH24, CHTBL(1, 25)), (SPCH25, CHTBL(1, 26)) D , (SPCH26, CHTBL(1, 27)), (SPCH27, CHTBL(1, 28)) E , (SPCH28, CHTBL(1, 29)), (SPCH29, CHTBL(1, 30)) F , (SPCH30, CHTBL(1, 31)), (SPCH31, CHTBL(1, 32)) EQUIVALENCE (SPACE , CHTBL(1, 33)), (EXCLAM, CHTBL(1, 34)) 1 , (QUOTE , CHTBL(1, 35)), (POUND , CHTBL(1, 36)) 2 , (DOLLAR, CHTBL(1, 37)), (PERCNT, CHTBL(1, 38)) 3 , (AMPERS, CHTBL(1, 39)), (APOSTR, CHTBL(1, 40)) 4 , (LPAREN, CHTBL(1, 41)), (RPAREN, CHTBL(1, 42)) 5 , (ASTER , CHTBL(1, 43)), (PLUS , CHTBL(1, 44)) 6 , (COMMA , CHTBL(1, 45)), (MINUS , CHTBL(1, 46)) 7 , (PERIOD, CHTBL(1, 47)), (SLASH , CHTBL(1, 48)) 8 , (ZERO , CHTBL(1, 49)), (ONE , CHTBL(1, 50)) 9 , (TWO , CHTBL(1, 51)), (THREE , CHTBL(1, 52)) A , (FOUR , CHTBL(1, 53)), (FIVE , CHTBL(1, 54)) B , (SIX , CHTBL(1, 55)), (SEVEN , CHTBL(1, 56)) C , (EIGHT , CHTBL(1, 57)), (NINE , CHTBL(1, 58)) D , (COLON , CHTBL(1, 59)), (SEMICO, CHTBL(1, 60)) E , (LESS , CHTBL(1, 61)), (EQUALS, CHTBL(1, 62)) F , (GREATR, CHTBL(1, 63)), (QUESTN, CHTBL(1, 64)) EQUIVALENCE (ATSIGN, CHTBL(1, 65)), (AUPPER, CHTBL(1, 66)) 1 , (BUPPER, CHTBL(1, 67)), (CUPPER, CHTBL(1, 68)) 2 , (DUPPER, CHTBL(1, 69)), (EUPPER, CHTBL(1, 70)) 3 , (FUPPER, CHTBL(1, 71)), (GUPPER, CHTBL(1, 72)) 4 , (HUPPER, CHTBL(1, 73)), (IUPPER, CHTBL(1, 74)) 5 , (JUPPER, CHTBL(1, 75)), (KUPPER, CHTBL(1, 76)) 6 , (LUPPER, CHTBL(1, 77)), (MUPPER, CHTBL(1, 78)) 7 , (NUPPER, CHTBL(1, 79)), (OUPPER, CHTBL(1, 80)) 8 , (PUPPER, CHTBL(1, 81)), (QUPPER, CHTBL(1, 82)) 9 , (RUPPER, CHTBL(1, 83)), (SUPPER, CHTBL(1, 84)) A , (TUPPER, CHTBL(1, 85)), (UUPPER, CHTBL(1, 86)) B , (VUPPER, CHTBL(1, 87)), (WUPPER, CHTBL(1, 88)) C , (XUPPER, CHTBL(1, 89)), (YUPPER, CHTBL(1, 90)) D , (ZUPPER, CHTBL(1, 91)), (LBRACK, CHTBL(1, 92)) E , (BKSLSH, CHTBL(1, 93)), (RBRACK, CHTBL(1, 94)) F , (CARET , CHTBL(1, 95)), (USCORE, CHTBL(1, 96)) EQUIVALENCE (ACCENT, CHTBL(1, 97)), (ALOWER, CHTBL(1, 98)) 1 , (BLOWER, CHTBL(1, 99)), (CLOWER, CHTBL(1, 100)) 2 , (DLOWER, CHTBL(1, 101)), (ELOWER, CHTBL(1, 102)) 3 , (FLOWER, CHTBL(1, 103)), (GLOWER, CHTBL(1, 104)) 4 , (HLOWER, CHTBL(1, 105)), (ILOWER, CHTBL(1, 106)) 5 , (JLOWER, CHTBL(1, 107)), (KLOWER, CHTBL(1, 108)) 6 , (LLOWER, CHTBL(1, 109)), (MLOWER, CHTBL(1, 110)) 7 , (NLOWER, CHTBL(1, 111)), (OLOWER, CHTBL(1, 112)) 8 , (PLOWER, CHTBL(1, 113)), (QLOWER, CHTBL(1, 114)) 9 , (RLOWER, CHTBL(1, 115)), (SLOWER, CHTBL(1, 116)) A , (TLOWER, CHTBL(1, 117)), (ULOWER, CHTBL(1, 118)) B , (VLOWER, CHTBL(1, 119)), (WLOWER, CHTBL(1, 120)) C , (XLOWER, CHTBL(1, 121)), (YLOWER, CHTBL(1, 122)) D , (ZLOWER, CHTBL(1, 123)), (LBRACE, CHTBL(1, 124)) E , (ORSIGN, CHTBL(1, 125)), (RBRACE, CHTBL(1, 126)) F , (TILDE , CHTBL(1, 127)), (SPC127, CHTBL(1, 128)) C COMMON /GRCS02/ CINDX1, CINDX2, CHTBL C DATA CINDX1 /1/ DATA CINDX2 /0/ C DATA SPCH00 /07, 34, 37, 67, 61, 01, 07, 37, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH01 /11, 34, 37, 47, 65, 63, 41, 21, 03, 05 1 , 27, 37, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH02 /07, 34, 37, 64, 61, 01, 04, 37, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH03 /02, 04, 64, 02, 37, 31, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH04 /02, 01, 67, 02, 07, 61, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH05 /06, 34, 37, 64, 31, 04, 37, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH06 /05, 31, 37, 64, 04, 37, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH07 /04, 01, 67, 07, 61, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH08 /04, 07, 67, 01, 61, 02, 14, 54, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH09 /03, 07, 34, 67, 02, 34, 31, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH10 /06, 61, 52, 56, 16, 12, 52, 02, 01, 12 1 , 02, 07, 16, 02, 67, 34, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH11 /02, 01, 67, 02, 07, 61, 02, 04, 64, 02 1 , 37, 31, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH12 /05, 01, 67, 07, 61, 01, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH13 /02, 24, 44, 02, 37, 31, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH14 /02, 07, 67, 02, 01, 61, 05, 31, 64, 37 1 , 04, 31, 01, 34, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH15 /07, 23, 43, 44, 24, 25, 45, 44, 02, 35 1 , 33, 02, 23, 24, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH16 /27, 01, 61, 62, 02, 03, 63, 64, 04, 05 1 , 65, 66, 06, 07, 67, 61, 51, 57, 47, 41 2 , 31, 37, 27, 21, 11, 17, 07, 01, 00, 00/ DATA SPCH17 /14, 21, 41, 52, 12, 03, 63, 64, 04, 05 1 , 65, 56, 16, 27, 47, 14, 03, 05, 16, 12 2 , 21, 27, 37, 31, 41, 47, 56, 52, 63, 65/ DATA SPCH18 /12, 31, 42, 22, 13, 53, 64, 04, 15, 55 1 , 46, 26, 37, 12, 64, 55, 53, 42, 46, 37 2 , 31, 22, 26, 15, 13, 04, 00, 00, 00, 00/ DATA SPCH19 /09, 26, 15, 13, 22, 42, 53, 55, 46, 26 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH20 /09, 27, 05, 03, 21, 41, 63, 65, 47, 27 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH21 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH22 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH23 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH24 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH25 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH26 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH27 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH28 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH29 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH30 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPCH31 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPACE /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA EXCLAM /02, 38, 33, 01, 30, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA QUOTE /02, 28, 26, 02, 48, 46, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA POUND /02, 10, 18, 02, 58, 50, 02, 62, 02, 02 1 , 06, 66, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA DOLLAR /10, 01, 51, 62, 63, 54, 14, 05, 06, 17 1 , 67, 02, 38, 30, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA PERCNT /05, 07, 18, 27, 16, 07, 02, 01, 67, 05 1 , 50, 61, 52, 41, 50, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA AMPERS /11, 60, 06, 07, 18, 48, 46, 02, 01, 10 1 , 30, 63, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA APOSTR /06, 24, 46, 48, 38, 37, 47, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LPAREN /04, 40, 22, 26, 48, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA RPAREN /04, 20, 42, 46, 28, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ASTER /02, 01, 67, 02, 07, 61, 02, 04, 64, 02 1 , 37, 31, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA PLUS /02, 14, 54, 02, 36, 32, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA COMMA /06, 20, 42, 44, 34, 33, 43, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA MINUS /02, 14, 54, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA PERIOD /05, 20, 30, 31, 21, 20, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SLASH /02, 01, 67, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ZERO /09, 10, 50, 61, 67, 58, 18, 07, 01, 10 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ONE /02, 10, 50, 03, 30, 38, 16, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA TWO /10, 07, 18, 58, 67, 65, 54, 24, 02, 00 1 , 60, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA THREE /07, 07, 18, 58, 67, 65, 54, 34, 06, 54 1 , 63, 61, 50, 10, 01, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA FOUR /05, 50, 58, 03, 02, 72, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA FIVE /10, 01, 10, 40, 62, 63, 45, 05, 08, 68 1 , 67, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SIX /11, 04, 54, 63, 61, 50, 10, 01, 06, 28 1 , 58, 67, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SEVEN /06, 20, 23, 67, 68, 08, 07, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA EIGHT /16, 14, 03, 01, 10, 50, 61, 63, 54, 14 1 , 05, 07, 18, 58, 67, 65, 54, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA NINE /11, 01, 10, 40, 62, 67, 58, 18, 07, 05 1 , 14, 64, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA COLON /05, 22, 32, 33, 23, 22, 05, 26, 36, 37 1 , 27, 26, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SEMICO /06, 10, 32, 34, 24, 23, 33, 05, 26, 36 1 , 37, 27, 26, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LESS /03, 50, 14, 58, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA EQUALS /02, 12, 52, 02, 16, 56, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA GREATR /03, 10, 54, 18, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA QUESTN /07, 06, 07, 18, 58, 67, 34, 33, 01, 31 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ATSIGN /13, 54, 45, 34, 43, 54, 64, 66, 48, 28 1 , 06, 02, 20, 50, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA AUPPER /05, 00, 05, 38, 65, 60, 02, 03, 63, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA BUPPER /06, 00, 50, 61, 63, 54, 14, 05, 08, 58 1 , 67, 65, 54, 02, 18, 10, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA CUPPER /08, 67, 58, 28, 06, 02, 20, 50, 61, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA DUPPER /06, 00, 40, 62, 66, 48, 08, 02, 18, 10 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA EUPPER /04, 60, 00, 08, 68, 02, 34, 04, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA FUPPER /03, 00, 08, 68, 02, 34, 04, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA GUPPER /10, 67, 58, 28, 06, 02, 20, 50, 61, 64 1 , 44, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA HUPPER /02, 00, 08, 02, 60, 68, 02, 04, 64, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA IUPPER /02, 10, 50, 02, 30, 38, 02, 18, 58, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA JUPPER /05, 01, 10, 20, 31, 38, 02, 18, 58, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA KUPPER /02, 00, 08, 02, 68, 02, 02, 24, 60, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LUPPER /03, 08, 00, 60, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA MUPPER /05, 00, 08, 35, 68, 60, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA NUPPER /02, 00, 08, 02, 07, 61, 02, 60, 68, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA OUPPER /09, 20, 40, 62, 66, 48, 28, 06, 02, 20 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA PUPPER /07, 00, 08, 58, 67, 66, 55, 05, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA QUPPER /09, 20, 40, 62, 66, 48, 28, 06, 02, 20 1 , 02, 33, 60, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA RUPPER /07, 00, 08, 58, 67, 66, 55, 05, 02, 15 1 , 60, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SUPPER /12, 01, 10, 50, 61, 63, 54, 14, 05, 07 1 , 18, 58, 67, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA TUPPER /02, 30, 38, 02, 08, 68, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA UUPPER /06, 08, 01, 10, 50, 61, 68, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA VUPPER /05, 08, 03, 30, 63, 68, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA WUPPER /05, 08, 00, 33, 60, 68, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA XUPPER /04, 00, 01, 67, 68, 04, 08, 07, 61, 60 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA YUPPER /03, 08, 35, 68, 02, 35, 30, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ZUPPER /06, 08, 68, 67, 01, 00, 60, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LBRACK /04, 40, 20, 28, 48, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA BKSLSH /02, 07, 61, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA RBRACK /04, 20, 40, 48, 28, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA CARET /03, 05, 38, 65, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA USCORE /02,-01,-61, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ACCENT /05, 27, 28, 38, 37, 55, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ALOWER /05, 06, 26, 35, 31, 40, 07, 31, 20, 10 1 , 01, 02, 13, 33, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA BLOWER /02, 08, 00, 08, 02, 20, 30, 41, 44, 35 1 , 25, 03, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA CLOWER /08, 41, 30, 10, 01, 04, 15, 35, 44, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA DLOWER /02, 48, 40, 08, 42, 20, 10, 01, 04, 15 1 , 25, 43, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ELOWER /10, 40, 10, 01, 04, 15, 35, 44, 43, 32 1 , 02, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA FLOWER /04, 10, 17, 28, 37, 02, 04, 24, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA GLOWER /11, 40, 10, 01, 04, 15, 35, 44,-41,-23 1 ,-13,-02, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA HLOWER /02, 00, 08, 05, 03, 25, 35, 44, 40, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ILOWER /01, 37, 03, 25, 35, 30, 02, 20, 40, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA JLOWER /01, 37, 06, 35,-32,-23,-13,-02,-01, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA KLOWER /02, 08, 00, 02, 01, 45, 03, 40, 22, 23 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LLOWER /02, 20, 40, 03, 30, 38, 28, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA MLOWER /06, 00, 04, 15, 25, 34, 30, 05, 34, 45 1 , 55, 64, 60, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA NLOWER /02, 00, 05, 05, 03, 25, 35, 44, 40, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA OLOWER /09, 01, 04, 15, 35, 44, 41, 30, 10, 01 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA PLOWER /02,-03, 05, 08, 03, 25, 35, 44, 41, 30 1 , 20, 02, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA QLOWER /02,-43, 45, 08, 43, 25, 15, 04, 01, 10 1 , 20, 42, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA RLOWER /02, 00, 05, 04, 03, 25, 35, 44, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SLOWER /09, 00, 30, 41, 42, 33, 13, 04, 15, 45 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA TLOWER /02, 06, 26, 05, 18, 11, 20, 30, 41, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ULOWER /05, 05, 01, 10, 20, 42, 02, 40, 45, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA VLOWER /05, 05, 02, 20, 42, 45, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA WLOWER /06, 05, 01, 10, 20, 31, 35, 05, 31, 40 1 , 50, 61, 65, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA XLOWER /02, 00, 55, 02, 05, 50, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA YLOWER /05, 05, 01, 10, 30, 41, 05, 45,-42,-33 1 ,-23,-12, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ZLOWER /04, 05, 55, 00, 50, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA LBRACE /06, 40, 30, 21, 23, 14, 04, 05, 14, 25 1 , 27, 38, 48, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA ORSIGN /02, 30, 38, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA RBRACE /06, 20, 30, 41, 43, 54, 64, 05, 54, 45 1 , 47, 38, 28, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA TILDE /04, 06, 28, 46, 68, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA SPC127 /00, 00, 00, 00, 00, 00, 00, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ END , 00, 00, 00, 00, 00 2 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00/ DATA FUPPER /03, 00, 08, 68, 02, 34, 04, 00, 00, 00 1 , 00, 00, 00, 00, 00, 00, 00, 00, 00, 00 2 , 00,pgplot/src/grgtc0.f010064400040640000322000000027340546005547000146710ustar00tjpcitmbr00000400000017 C*GRGTC0 -- obtain character digitization C+ SUBROUTINE GRGTC0 (CHAR,CENTER,POINTS,X,Y,MORE) C C GRPCKG (internal routine): obtain character digitization. C C (10-Feb-1983) C----------------------------------------------------------------------- EXTERNAL GRDAT2 LOGICAL CENTER INTEGER POINTS, CHAR REAL X(1) REAL Y(1) LOGICAL MORE C INTEGER CINDX1, CINDX2 INTEGER CTD1, CTD2 PARAMETER (CTD1 = 30, CTD2 = 128) INTEGER CHTBL(CTD1, CTD2) COMMON /GRCS02/ CINDX1, CINDX2, CHTBL C INTEGER I INTEGER COORDS LOGICAL TAILED C----------------------------------------------------------------------- IF (CINDX2.LE.0) CINDX2 = CHAR + 1 C C Get the next segment of the character. C POINTS = CHTBL(CINDX1, CINDX2) IF(POINTS .EQ. 0) GO TO 240 DO 220 I = 1, POINTS CINDX1 = CINDX1 + 1 COORDS = CHTBL(CINDX1, CINDX2) TAILED = COORDS .LT. 0 IF(TAILED) COORDS = IABS(COORDS) X(I) = FLOAT(COORDS / 10) Y(I) = FLOAT(MOD(COORDS, 10)) IF(TAILED) Y(I) = - Y(I) IF(.NOT. CENTER) GO TO 220 X(I) = X(I) - 3.0 Y(I) = Y(I) - 4.0 220 CONTINUE 240 CONTINUE C C Set status and return. C IF(CINDX1 .EQ. CTD1) GO TO 320 CINDX1 = CINDX1 + 1 IF(CHTBL(CINDX1, CINDX2) .EQ. 0) GO TO 320 MORE = .TRUE. RETURN 320 MORE = .FALSE. CINDX1 = 1 CINDX2 = 0 RETURN END pgplot/src/grchsz.f010064400040640000322000000017010633173337100147750ustar00tjpcitmbr00000400000017 C*GRCHSZ -- inquire default character attributes C+ SUBROUTINE GRCHSZ (IDENT,XSIZE,YSIZE,XSPACE,YSPACE) C C GRPCKG: Obtain the default character attributes. C C Arguments: C C IDENT (input, integer): the plot identifier, returned by GROPEN. C XSIZE, YSIZE (output, real): the default character size C (absolute device units). C XSPACE, YSPACE (output, real): the default character spacing C (absolute units); XSPACE is the distance between the lower left C corners of adjacent characters in a plotted string; YSPACE C is the corresponding vertical spacing. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IDENT REAL FACTOR, XSIZE, YSIZE, XSPACE, YSPACE C CALL GRSLCT(IDENT) FACTOR = GRCSCL(IDENT) XSIZE = GRCXSZ * FACTOR YSIZE = GRCYSZ * FACTOR XSPACE = 10.0 * FACTOR YSPACE = 13.0 * FACTOR END pgplot/src/grclip.f010064400040640000322000000015350546005546500147650ustar00tjpcitmbr00000400000017C*GRCLIP -- clip a point against clipping rectangle C+ SUBROUTINE GRCLIP (X,Y,XMIN,XMAX,YMIN,YMAX,C) REAL X,Y REAL XMIN,XMAX,YMIN,YMAX INTEGER C C C GRPCKG (internal routine): support routine for the clipping algorithm; C called from GRLIN0 only. C is a 4 bit code indicating the relationship C between point (X,Y) and the window boundaries; 0 implies the point is C within the window. C C Arguments: C-- C (11-Feb-1983) C Revised 20-Jun-1985 (TJP); use floating arithmetic C Revised 12-Jun-1992 (TJP); clip exactly on the boundary C----------------------------------------------------------------------- C C = 0 IF (X.LT.XMIN) THEN C = 1 ELSE IF (X.GT.XMAX) THEN C = 2 END IF IF (Y.LT.YMIN) THEN C = C+4 ELSE IF (Y.GT.YMAX) THEN C = C+8 END IF END ndow boundaries; 0 implies the point is C within the window. C C Arguments: C-- C (11-Feb-1983) C Revised 20-Jun-1985 (TJP); use floating arithmetic C Revised 12-Jpgplot/src/grclos.f010064400040640000322000000026410613063134500147650ustar00tjpcitmbr00000400000017C*GRCLOS -- close graphics device C+ SUBROUTINE GRCLOS C C GRPCKG: Close the open plot on the current device. Any pending output C is sent to the device, the device is released for other users or the C disk file is closed, and no further plotting is allowed on the device C without a new call to GROPEN. C C Arguments: none. C-- C 1-Jun-1984 - [TJP]. C 17-Jul-1984 - ignore call if plot is not open [TJP]. C 1-Oct-1984 - reset color to default (1) and position text cursor C at bottom of VT screen [TJP]. C 19-Oct-1984 - add VV device [TJP]. C 22-Dec-1984 - use GRBUFL and GRIOTA parameters [TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - modify END_PICTURE sequence [AFT]. C 11-Jun-1987 - remove built-ins [TJP]. C 31-Aug-1987 - do not eject blank page [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER CHR C C Check a plot is open. C IF (GRCIDE.LT.1) RETURN C C Reset color to default (1). This is useful C for VT240 terminals, which use the color tables for text. C CALL GRSCI(1) C C Flush buffer. C CALL GRTERM C C End picture. C CALL GREPIC C C This plot identifier is no longer in use. C Set state to "workstation closed". C GRSTAT(GRCIDE) = 0 GRCIDE = 0 C C Close workstation. C CALL GREXEC(GRGTYP,10,RBUF,NBUF,CHR,LCHR) C END pgplot/src/grclpl.f010064400040640000322000000047650566004037600147750ustar00tjpcitmbr00000400000017C*GRCLPL -- clip line against clipping rectangle C+ SUBROUTINE GRCLPL (X0,Y0,X1,Y1,VIS) C C GRPCKG (internal routine): Change the end-points of the line (X0,Y0) C (X1,Y1) to clip the line at the window boundary. The algorithm is C that of Cohen and Sutherland (ref: Newman & Sproull). C C Arguments: C C X0, Y0 (input/output, real): device coordinates of starting point C of line. C X1, Y1 (input/output, real): device coordinates of end point of line. C VIS (output, logical): .TRUE. if line lies wholly or partially C within the clipping rectangle; .FALSE. if it lies entirely C outside the rectangle. C-- C 13-Jul-1984 - [TJP]. C 20-Jun-1985 - [TJP] - revise clipping algorithm. C 28-Jun-1991 - [TJP] - use IAND(). C 12-Jun-1992 - [TJP] - clip exactly on the boundary. C C Caution: IAND is a non-standard intrinsic function to do bitwise AND C of two integers. If it is not supported by your Fortran compiler, you C will need to modify this routine or supply an IAND function. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL VIS INTEGER C0,C1,C REAL XMIN,XMAX,YMIN,YMAX REAL X,Y, X0,Y0, X1,Y1 INTEGER IAND C XMIN = GRXMIN(GRCIDE) YMIN = GRYMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMAX = GRYMAX(GRCIDE) CALL GRCLIP(X0,Y0,XMIN,XMAX,YMIN,YMAX,C0) CALL GRCLIP(X1,Y1,XMIN,XMAX,YMIN,YMAX,C1) 10 IF (C0.NE.0 .OR. C1.NE.0) THEN IF (IAND(C0,C1).NE.0) THEN C ! line is invisible VIS = .FALSE. RETURN END IF C = C0 IF (C.EQ.0) C = C1 IF (IAND(C,1).NE.0) THEN C ! crosses XMIN Y = Y0 + (Y1-Y0)*(XMIN-X0)/(X1-X0) X = XMIN ELSE IF (IAND(C,2).NE.0) THEN C ! crosses XMAX Y = Y0 + (Y1-Y0)*(XMAX-X0)/(X1-X0) X = XMAX ELSE IF (IAND(C,4).NE.0) THEN C ! crosses YMIN X = X0 + (X1-X0)*(YMIN-Y0)/(Y1-Y0) Y = YMIN ELSE IF (IAND(C,8).NE.0) THEN C ! crosses YMAX X = X0 + (X1-X0)*(YMAX-Y0)/(Y1-Y0) Y = YMAX END IF IF (C.EQ.C0) THEN X0 = X Y0 = Y CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C0) ELSE X1 = X Y1 = Y CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C1) END IF GOTO 10 END IF VIS = .TRUE. END pgplot/src/pghtch.f010064000040640000322000000123160634707574600147660ustar00tjpcitmbr00000400000017C.PGHTCH -- hatch a polygonal area (internal routine) C. SUBROUTINE PGHTCH(N, X, Y, DA) INTEGER N REAL X(*), Y(*), DA C C Hatch a polygonal area using equi-spaced parallel lines. The lines C are drawn using the current line attributes: line style, line width, C and color index. Cross-hatching can be achieved by calling this C routine twice. C C Limitations: the hatching will not be done correctly if the C polygon is so complex that a hatch line intersects more than C 32 of its sides. C C Arguments: C N (input) : the number of vertices of the polygonal. C X,Y (input) : the (x,y) world-coordinates of the vertices C (in order). C DA (input) : 0.0 for normal hatching, 90.0 for perpendicular C hatching. C-- C Reference: I.O. Angel and G. Griffith "High-resolution computer C graphics using Fortran 77", Halsted Press, 1987. C C 18-Feb-1995 [TJP]. C----------------------------------------------------------------------- C C MAXP is the maximum number of intersections any hatch line may make C with the sides of the polygon. C INTEGER MAXP PARAMETER (MAXP=32) INTEGER NP(MAXP), I,J, II,JJ, NMIN,NMAX, NX, NI, NNP REAL ANGLE, SEPN, PHASE REAL RMU(MAXP), DX,DY, C, CMID,CMIN,CMAX, SX,SY, EX,EY, DELTA REAL QX,QY, R, RMU1, RMU2, XI,YI, BX,BY REAL DH, XS1, XS2, YS1, YS2, XL, XR, YT, YB, DINDX, DINDY C C Check arguments. C IF (N.LT.3) RETURN CALL PGQHS(ANGLE, SEPN, PHASE) ANGLE = ANGLE + DA IF (SEPN.EQ.0.0) RETURN C C The unit spacing is 1 percent of the smaller of the height or C width of the view surface. The line-spacing (DH), in inches, is C obtained by multiplying this by argument SEPN. C CALL PGQVSZ(1, XS1, XS2, YS1, YS2) DH = SEPN*MIN(ABS(XS2-XS1),ABS(YS2-YS1))/100.0 C C DINDX and DINDY are the scales in inches per world-coordinate unit. C CALL PGQVP(1, XS1, XS2, YS1, YS2) CALL PGQWIN(XL, XR, YB, YT) IF (XR.NE.XL .AND. YT.NE.YB) THEN DINDX = (XS2 - XS1) / (XR - XL) DINDY = (YS2 - YS1) / (YT - YB) ELSE RETURN END IF C C Initialize. C CALL PGBBUF C C The vector (SX,SY) is a vector length DH perpendicular to C the hatching lines, which have vector (DX,DY). C DX = COS(ANGLE/57.29578) DY = SIN(ANGLE/57.29578) SX = (-DH)*DY SY = DH*DX C C The hatch lines are labelled by a parameter C, the distance from C the coordinate origin. Calculate CMID, the C-value of the line C that passes through the hatching reference point (BX,BY), and C CMIN and CMAX, the range of C-values spanned by lines that intersect C the polygon. C BX = PHASE*SX BY = PHASE*SY CMID = DX*BY - DY*BX CMIN = DX*Y(1)*DINDY - DY*X(1)*DINDX CMAX = CMIN DO 10 I=2,N C = DX*Y(I)*DINDY - DY*X(I)*DINDX CMIN = MIN(C,CMIN) CMAX = MAX(C,CMAX) 10 CONTINUE C C Compute integer labels for the hatch lines; N=0 is the line C which passes through the reference point; NMIN and NMAX define C the range of labels for lines that intersect the polygon. C [Note that INT truncates towards zero; we need FLOOR and CEIL C functions.] C CMIN = (CMIN-CMID)/DH CMAX = (CMAX-CMID)/DH NMIN = INT(CMIN) IF (REAL(NMIN).LT.CMIN) NMIN = NMIN+1 NMAX = INT(CMAX) IF (REAL(NMAX).GT.CMAX) NMAX = NMAX-1 C C Each iteration of the following loop draws one hatch line. C DO 60 J=NMIN,NMAX C C The parametric representation of this hatch line is C (X,Y) = (QX,QY) + RMU*(DX,DY). C QX = BX + REAL(J)*SX QY = BY + REAL(J)*SY C C Find the NX intersections of this line with the edges of the polygon. C NX = 0 NI = N DO 20 I=1,N EX = (X(I) - X(NI))*DINDX EY = (Y(I) - Y(NI))*DINDY DELTA = EX*DY - EY*DX IF (ABS(DELTA).LT.1E-5) THEN C -- lines are parallel ELSE C -- lines intersect in (XI,YI) R = ((QX-X(NI)*DINDX)*DY - (QY-Y(NI)*DINDY)*DX)/DELTA IF (R.GT.0.0 .AND. R.LE.1.0) THEN IF (NX.LT.MAXP) NX = NX+1 NP(NX) = NX IF (ABS(DX).GT.0.5) THEN XI = X(NI)*DINDX + R*EX RMU(NX) = (XI-QX)/DX ELSE YI = Y(NI)*DINDY + R*EY RMU(NX) = (YI-QY)/DY END IF END IF END IF NI = I 20 CONTINUE C C The RMU array now contains the intersections. Sort them into order. C DO 40 II=1,NX-1 DO 30 JJ=II+1,NX IF (RMU(NP(II)).LT.RMU(NP(JJ))) THEN NNP = NP(II) NP(II) = NP(JJ) NP(JJ) = NNP END IF 30 CONTINUE 40 CONTINUE C C Join the intersections in pairs. C NI = 1 C -- do while NI < NX 50 IF (NI .LT. NX) THEN RMU1 = RMU(NP(NI)) RMU2 = RMU(NP(NI+1)) CALL PGMOVE((QX+RMU1*DX)/DINDX, (QY+RMU1*DY)/DINDY) CALL PGDRAW((QX+RMU2*DX)/DINDX, (QY+RMU2*DY)/DINDY) NI = NI+2 GOTO 50 END IF 60 CONTINUE C C Tidy up. C CALL PGEBUF C END EPN, PHASE REAL RMU(MAXP), DX,DY, C, CMID,CMIN,CMAX, SX,SY, EX,EY, DELTA REAL QX,QY, R, RMU1, RMU2, XI,YI, BX,BY REAL DH, XS1, XS2, YS1, YS2, XL, XR, YT, YB, DINDX, DINDY C C Check arguments. C IF (N.LT.3) RETURN CALL PGQHS(ANGLE, SEPN, PHASE) ANGLE = ANGLE + DA Ipgplot/src/grcurs.f010064400040640000322000000075250570704725300150170ustar00tjpcitmbr00000400000017C*GRCURS -- read cursor position C+ INTEGER FUNCTION GRCURS (IDENT,IX,IY,IXREF,IYREF,MODE,POSN,CH) INTEGER IDENT, IX, IY, IXREF, IYREF, MODE, POSN CHARACTER*(*) CH C C GRPCKG: Read the cursor position and a character typed by the user. C The position is returned in absolute device coordinates (pixels). C GRCURS positions the cursor at the position specified, and C allows the user to move the cursor using the joystick or C arrow keys or whatever is available on the device. When he has C positioned the cursor, the user types a single character on his C keyboard; GRCURS then returns this character and the new cursor C position. C C "Rubber band" feedback of cursor movement can be requested (although C it may not be supported on some devices). If MODE=1, a line from C the anchor point to the current cursor position is displayed as C the cursor is moved. If MODE=2, a rectangle with vertical and C horizontal sides and one vertex at the anchor point and the opposite C vertex at the current cursor position is displayed as the cursor is C moved. C C Returns: C C GRCURS (integer): 1 if the call was successful; 0 if the device C has no cursor or some other error occurs. C C Arguments: C C IDENT (integer, input): GRPCKG plot identifier (from GROPEN). C IX (integer, in/out): the device x-coordinate of the cursor. C IY (integer, in/out): the device y-coordinate of the cursor. C IXREF (integer, input): x-coordinate of anchor point. C IYREF (integer, input): y-coordinate of anchor point. C MODE (integer, input): type of rubber-band feedback. C CH (char, output): the character typed by the user; if the device C has no cursor or if some other error occurs, the value CHAR(0) C [ASCII NUL character] is returned. C-- C 1-Aug-1984 - extensively revised [TJP]. C 29-Jan-1985 - add ARGS and HP2648 devices (?) [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 11-Jun-1987 - remove built-ins [TJP]. C 15-Feb-1988 - remove test for batch jobs; leave this to the device C handler [TJP]. C 13-Dec-1990 - remove code to abort after 10 cursor errors [TJP]. C 7-Sep-1994 - add support for rubber-band modes [TJP]. C 17-Jan-1995 - start picture if necessary [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER NBUF, LCHR, ICURS, ERRCNT CHARACTER*16 CHR CHARACTER C SAVE ERRCNT DATA ERRCNT/0/ C C Validate identifier, and select device. C CALL GRSLCT(IDENT) CALL GRTERM C C Begin picture if necessary. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C C Make sure cursor is on view surface. (It does not C have to be in the viewport.) C IX = MAX(0,MIN(GRXMXA(GRCIDE),IX)) IY = MAX(0,MIN(GRYMXA(GRCIDE),IY)) C C Does the device have a cursor? C C = GRGCAP(GRCIDE)(2:2) ICURS = 0 IF (C.EQ.'C' .OR. C.EQ.'X') ICURS=1 C C Device does have a cursor. C IF (ICURS.GT.0) THEN C -- initial position of cursor RBUF(1) = IX RBUF(2) = IY C -- reference point for rubber band RBUF(3) = IXREF RBUF(4) = IYREF C -- rubber band mode RBUF(5) = MODE C -- position cursor? RBUF(6) = POSN NBUF = 6 LCHR = 0 CALL GREXEC(GRGTYP,17,RBUF,NBUF,CHR,LCHR) IX = RBUF(1) IY = RBUF(2) CH = CHR(1:1) GRCURS = 1 C -- error if driver returns NUL IF (ICHAR(CHR(1:1)).EQ.0) GRCURS = 0 C C Other devices are illegal. C ELSE CALL GREXEC(GRGTYP, 1,RBUF,NBUF,CHR,LCHR) LCHR = INDEX(CHR,' ') IF (ERRCNT.LE.10) CALL 1 GRWARN('output device has no cursor: '//CHR(:LCHR)) CH = CHAR(0) GRCURS = 0 ERRCNT = ERRCNT+1 END IF C END pgplot/src/grinqfont.f010064400040640000322000000002020546005547000154760ustar00tjpcitmbr00000400000017C*GRINQFONT -- inquire current font [obsolete] C SUBROUTINE GRINQFONT (IF) INTEGER IF CALL GRQFNT(IF) END pgplot/src/grdot0.f010064400040640000322000000024100566551112600146730ustar00tjpcitmbr00000400000017C*GRDOT0 -- draw a dot C+ SUBROUTINE GRDOT0 (X,Y) C C GRPCKG (internal routine): Draw a single dot (pixel) at a specified C location. C C Arguments: C C X, Y (real, input): absolute device coordinates of the dot (these C are rounded to the nearest integer by GRDOT0). C-- C (1-Jun-1984) C 22-Oct-1984 - rewrite [TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - If needed, calls begin picture [AFT]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF, LCHR REAL X, Y, RBUF(6) CHARACTER CHR C C (X,Y) is the new current position. C GRXPRE(GRCIDE) = X GRYPRE(GRCIDE) = Y C C Check window. C IF (X .LT. GRXMIN(GRCIDE)) RETURN IF (X .GT. GRXMAX(GRCIDE)) RETURN IF (Y .LT. GRYMIN(GRCIDE)) RETURN IF (Y .GT. GRYMAX(GRCIDE)) RETURN C C Begin picture if necessary. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C C If a "thick pen" is to be simulated, use the line-drawing routines C instead. C IF (GRWIDT(GRCIDE).GT.1) THEN CALL GRLIN3(X,Y,X,Y) ELSE RBUF(1)=X RBUF(2)=Y NBUF=2 CALL GREXEC(GRGTYP,13,RBUF,NBUF,CHR,LCHR) END IF END pgplot/src/gretxt.f010064400040640000322000000016120546005546700150200ustar00tjpcitmbr00000400000017 C*GRETXT -- erase text from graphics screen C+ SUBROUTINE GRETXT C C GRPCKG: Erase the text screen. Some graphics devices have C two superimposed view surfaces, of which one is used for graphics and C the other for alphanumeric text. This routine erases the text C view surface without affecting the graphics view surface. It does C nothing if there is no text view surface associated with the device. C C Arguments: none. C-- C (1-Feb-1983) C 16-Oct-1984 - add ID100 device [RSS/TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 11-Jun-1987 - remove built-in devices [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' CHARACTER*1 CHR REAL RBUF(6) INTEGER NBUF,LCHR C IF (GRCIDE.GE.1) THEN CALL GREXEC(GRGTYP,18,RBUF,NBUF,CHR,LCHR) END IF C END with the device. C C Arguments: none. C-- C (1-Feb-1983) C 16-Oct-1984 - add ID100 device [RSS/TJP]. C 29-Jan-1985 - apgplot/src/grfao.f010064400040640000322000000020700546005546700146000ustar00tjpcitmbr00000400000017C*GRFAO - format character string containing integers C+ SUBROUTINE GRFAO (FORMAT, L, STR, V1, V2, V3, V4) CHARACTER*(*) FORMAT INTEGER L CHARACTER*(*) STR INTEGER V1, V2, V3, V4 C C The input string FORMAT is copied to the output string STR with C the first occurrence of '#' replaced by the value of V1, the second C by the value of V2, etc. The length of the resulting string is C returned in L. C----------------------------------------------------------------------- INTEGER I,Q,VAL,GRITOC C L = 0 Q = 0 DO 10 I=1,LEN(FORMAT) IF (L.GE.LEN(STR)) RETURN IF (FORMAT(I:I).NE.'#') THEN L = L+1 STR(L:L) = FORMAT(I:I) ELSE Q = Q+1 VAL = 0 IF (Q.EQ.1) VAL = V1 IF (Q.EQ.2) VAL = V2 IF (Q.EQ.3) VAL = V3 IF (Q.EQ.4) VAL = V4 L = L + GRITOC(VAL, STR(L+1:)) END IF 10 CONTINUE C----------------------------------------------------------------------- END pgplot/src/grinqli.f010064400040640000322000000005750546005547000151510ustar00tjpcitmbr00000400000017 C*GRINQLI -- *obsolete routine* C+ SUBROUTINE GRINQLI (INTEN) C C GRPCKG: obtain the line intensity of the current graphics device. C Obsolete routine. C Argument: C C INTEN (integer, output): always returns 1. C-- C (1-Feb-1983; revised 16-Aug-1987). C----------------------------------------------------------------------- INTEGER INTEN C INTEN = 1 END pgplot/src/grinqpen.f010064400040640000322000000005420546005547100153220ustar00tjpcitmbr00000400000017 C*GRINQPEN -- *obsolete routine* C+ SUBROUTINE GRINQPEN (IP) C C GRPCKG: obtain the pen number of the current graphics device. C Obsolete routine. C Argument: C C IP (integer, output): always receives 1. C-- C 16-Aug-1987 - [TJP]. C----------------------------------------------------------------------- INTEGER IP C IP = 1 END pgplot/src/grlinr.f010064400040640000322000000012010546005547200147660ustar00tjpcitmbr00000400000017 C*GRLINR -- draw a line (relative, world coordinates) C+ SUBROUTINE GRLINR (DX,DY) C C GRPCKG: draw a line from the current position by a specified C relative displacement. C C Arguments: C C DX, DY (real, input): the displacement in world coordinates: the pen C position is incremented by DX in x and DY in y. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL DX,DY C IF (GRCIDE.GE.1) THEN CALL GRLIN0( DX * GRXSCL(GRCIDE) + GRXPRE(GRCIDE), 1 DY * GRYSCL(GRCIDE) + GRYPRE(GRCIDE) ) END IF END pgplot/src/grmark.f010064400040640000322000000031400546005547300147610ustar00tjpcitmbr00000400000017 C*GRMARK -- mark points with specified symbol C+ SUBROUTINE GRMARK (IDENT,CENTER,SYMBOL,ABSXY,POINTS,X,Y) C C GRPCKG: mark a sequence of points with a specified symbol. The C plot is windowed in the current subarea. C C Arguments: C C IDENT (integer, input): plot identifier from GROPEN. C CENTER (input, logical): if .TRUE. the symbol is centered on the point, C otherwise the bottom left corner is placed at the point. C SYMBOL (byte or integer, input): code number of symbol in range 0-127 C (ASCII character or special symbol); if SYMBOL is outside this C range, nothing is plotted. C ABSXY (logical, input): if .TRUE. (X,Y) are absolute (device) C coordinates; otherwise they are world coordinates and the C scaling transformation is applied. C POINTS (integer, input): the number of points; if POINTS is less than C or equal to 0, nothing is plotted. C X,Y (real arrays, dimension at least POINTS, input): the coordinate C pairs; if POINTS=1, these may be scalars instead of arrays. C C (9-Mar-1983) C----------------------------------------------------------------------- INTEGER SYMBOL CHARACTER*1 MARK INTEGER I, IDENT, POINTS LOGICAL ABSXY, CENTER REAL X(*), Y(*) C----------------------------------------------------------------------- IF (POINTS.LE.0 .OR. SYMBOL.LT.0 .OR. SYMBOL.GT.127) RETURN CALL GRSLCT(IDENT) MARK = CHAR(SYMBOL) DO 10 I=1,POINTS CALL GRCHR0(.TRUE., CENTER, 0.0, ABSXY, X(I), Y(I), MARK) 10 CONTINUE C----------------------------------------------------------------------- END pgplot/src/gritoc.f010064400040640000322000000020310546005547100147610ustar00tjpcitmbr00000400000017C*GRITOC - convert integer to character string C+ INTEGER FUNCTION GRITOC(INT, STR) INTEGER INT CHARACTER*(*) STR C C Convert integer INT into (decimal) character string in STR. C----------------------------------------------------------------------- CHARACTER*10 DIGITS INTEGER D, I, INTVAL, J, L CHARACTER K DATA DIGITS /'0123456789'/ C INTVAL = ABS(INT) I = 0 C C Generate digits in reverse order. C 10 CONTINUE I = I+1 D = 1 + MOD(INTVAL, 10) STR(I:I) = DIGITS(D:D) INTVAL = INTVAL/10 IF (I.LT.LEN(STR) .AND. INTVAL.NE.0) GOTO 10 C C Add minus sign if necessary. C IF (INT.LT.0 .AND. I.LT.LEN(STR)) THEN I = I+1 STR(I:I) = '-' END IF GRITOC = I C C Reverse string in place. C L = I/2 DO 20 J=1,L K = STR(I:I) STR(I:I) = STR(J:J) STR(J:J) = K I = I-1 20 CONTINUE C----------------------------------------------------------------------- END r to character string C+ INTEGER FUNCTION GRITOC(INT, STR) INTEGER INT CHARACTER*(*) STR C C Convert integer INT into (decimal) character string in STR. C----------------------------------------------------------------------- CHARACTER*10 DIGITS INTEGER D, I, INTVAL, J, L CHARACTER K DATA DIGITS /'0123456789'/ C INTVAL = ABS(INT) I = 0 C C Generate digits in reverse order. C 10 CONTINUE I = I+1 D = 1 + MOD(pgplot/src/grlen.f010064400040640000322000000034300546005547100146050ustar00tjpcitmbr00000400000017C*GRLEN -- inquire plotted length of character string C+ SUBROUTINE GRLEN (STRING, D) C C GRPCKG: length of text string (absolute units) C-- C (3-Mar-1983) C 19-Jan-1988 - remove unused label [TJP]. C 9-Sep-1989 - standardize [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL UNUSED INTEGER XYGRID(300) INTEGER LIST(256) CHARACTER*(*) STRING REAL FACTOR, COSA, SINA, DX, D, RATIO, FNTBAS, FNTFAC INTEGER I, IFNTLV, LX, NLIST INTRINSIC ABS, LEN C D = 0.0 IF (LEN(STRING).LE.0) RETURN C----------------------------------------------------------------------- C Compute scaling and orientation C----------------------------------------------------------------------- FACTOR = GRCFAC(GRCIDE)/2.5 RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE) COSA = FACTOR SINA = 0.0 FNTBAS = 0.0 FNTFAC = 1.0 IFNTLV = 0 C C Convert string to symbol numbers: C \u and \d escape sequences are converted to -1,-2 C CALL GRSYDS(LIST,NLIST,STRING,GRCFNT(GRCIDE)) C C Plot the string of characters C DO 380 I = 1,NLIST IF (LIST(I).LT.0) THEN IF (LIST(I).EQ.-1) THEN IFNTLV = IFNTLV+1 FNTBAS = FNTBAS + 16.0*FNTFAC FNTFAC = 0.6**ABS(IFNTLV) ELSE IF (LIST(I).EQ.-2) THEN IFNTLV = IFNTLV-1 FNTFAC = 0.6**ABS(IFNTLV) FNTBAS = FNTBAS - 16.0*FNTFAC END IF GOTO 380 END IF CALL GRSYXD(LIST(I),XYGRID,UNUSED) LX = XYGRID(5)-XYGRID(4) DX = COSA*LX*RATIO D = D + DX*FNTFAC 380 CONTINUE C END pgplot/src/grlin1.f010064400040640000322000000047410546005547200147010ustar00tjpcitmbr00000400000017C*GRLIN1 -- draw a dashed line C+ SUBROUTINE GRLIN1 (X0,Y0,X1,Y1,RESET) C C GRPCKG : dashed line. Generate a visible dashed line between points C (X0,Y0) and (X1,Y1) according to the dash pattern stored in common. C If RESET = .TRUE., the pattern will start from the beginning. C Otherwise, it will continue from its last position. C DASHED LINE PATTERN ARRAY CONTAINING LENGTHS OF C MARKS AND SPACES IN UNIT CUBE: GRPATN(*) C OFFSET IN CURRENT PATTERN SEGMENT: GRPOFF C CURRENT PATTERN SEGMENT NUMBER: GRIPAT C NUMBER OF PATTERN SEGMENTS: 8 C-- C (1-Feb-1983) C 6-Sep-1989 - Changes for standard Fortran-77 [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C REAL ADJUST, ARG1, ARG2, ALFARG REAL SCALE, SEGLEN, X1, X0, Y1, Y0, DS, DSOLD REAL ALPHA1, ALPHA2, XP, YP, XQ, YQ LOGICAL RESET INTEGER THICK INTRINSIC ABS, MIN, MOD, REAL, SQRT C ADJUST(ARG1,ARG2,ALFARG) = ALFARG*(ARG2 - ARG1) + ARG1 C THICK = GRWIDT(GRCIDE) SCALE = SQRT(REAL(ABS(THICK))) IF (RESET) THEN GRPOFF(GRCIDE) = 0.0 GRIPAT(GRCIDE) = 1 END IF SEGLEN = SQRT((X1-X0)**2 + (Y1-Y0)**2) IF (SEGLEN .EQ. 0.0) RETURN DS = 0.0 C C Repeat until (ALPHA2 .GE. 1.0) C C Line segments matching the pattern segments are determined C by finding values (ALPHA1,ALPHA2) defining the start and end C of the segment in the parametric equation (1-ALPHA)*P1 + ALPHA*P2 C defining the line. DS measures the progress along the line C segment and defines the starting ALPHA1. The ending ALPHA2 C is computed from the end of the current pattern mark or space C or the segment end, whichever comes first. C 10 DSOLD = DS ALPHA1 = DS/SEGLEN ALPHA2 = MIN(1.0,(DS+SCALE*GRPATN(GRCIDE,GRIPAT(GRCIDE))- 1 GRPOFF(GRCIDE))/SEGLEN) IF (MOD(GRIPAT(GRCIDE),2) .NE. 0) THEN XP = ADJUST(X0,X1,ALPHA1) YP = ADJUST(Y0,Y1,ALPHA1) XQ = ADJUST(X0,X1,ALPHA2) YQ = ADJUST(Y0,Y1,ALPHA2) IF (THICK.GT.1) THEN CALL GRLIN3(XP,YP,XQ,YQ) ELSE CALL GRLIN2(XP,YP,XQ,YQ) END IF END IF DS = ALPHA2*SEGLEN IF (ALPHA2 .GE. 1.0) THEN GRPOFF(GRCIDE) = GRPOFF(GRCIDE) + DS - DSOLD RETURN END IF GRIPAT(GRCIDE) = MOD(GRIPAT(GRCIDE),8) + 1 GRPOFF(GRCIDE) = 0.0 GO TO 10 END pgplot/src/grlin3.f010064400040640000322000000051140634707672700147110ustar00tjpcitmbr00000400000017C*GRLIN3 -- draw a thick line (multiple strokes) C+ SUBROUTINE GRLIN3 (X0,Y0,X1,Y1) C C GRPCKG: draw a heavy line from (X0,Y0) to (X1,Y1) by making multiple C strokes. In order to simulate a thick pen, the line drawn has C circular, rather than square, end points. If this is not done, C thick letters and other figures have an abnormal and unpleasant C appearance. C C Vocabulary: C C LINEWT: the number of strokes required to draw the line; if C this is odd, one stroke will lie along the requested vector. C The nominal line thickness is (LINEWT-1)*0.005 in. C RSQURD: the square of the semi-line thickness. C (DX,DY): the vector length of the line. C (VX,VY): a vector of length 1 pixel in the direction of the line. C (VY,-VX): a vector of length 1 pixel perpendicular to (VX,VY). C OFF: the offset parallel to (VY,-VX) of the K'th stroke. C (VXK,VYK): the vector increment of the K'th stroke to allow for the C semi-circular terminal on the line. C (PXK,PYK): the vector offset of the K'th stroke perpendicular to the C line vector. C-- C (1-Feb-1983) C 23-Nov-1994 - change algorithm so that the unit of line-width is C 0.005 inch instead of 1 pixel [TJP]. C March 1995 - added ABS to prevent domain error in SQRT (CTD) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER K,LINEWT REAL DX,DY, HK, OFF, PXK,PYK, RSQURD, VLEN,VX,VY,VXK,VYK REAL X0,X1,Y0,Y1 REAL XS0,XS1, YS0,YS1, SPIX,SPIY LOGICAL VIS C C Determine number of strokes and line thickness. C LINEWT = GRWIDT(GRCIDE) RSQURD = ((LINEWT-1)**2)*0.25 C C Determine the vectors (VX,VY), (VY,-VX). If the line-length is zero, C pretend it is a very short horizontal line. C DX = X1 - X0 DY = Y1 - Y0 VLEN = SQRT(DX**2 + DY**2) SPIX = GRPXPI(GRCIDE)*0.005 SPIY = GRPYPI(GRCIDE)*0.005 C IF (VLEN .EQ. 0.0) THEN VX = SPIX VY = 0.0 ELSE VX = DX/VLEN*SPIX VY = DY/VLEN*SPIY END IF C C Draw LINEWT strokes. We have to clip again in case thickening the C line has taken us outside the window. C OFF = (LINEWT-1)*0.5 DO 10 K=1,LINEWT PXK = VY*OFF PYK = -(VX*OFF) HK = SQRT(ABS(RSQURD - OFF**2)) VXK = VX*HK VYK = VY*HK XS1 = X1+PXK+VXK YS1 = Y1+PYK+VYK XS0 = X0+PXK-VXK YS0 = Y0+PYK-VYK CALL GRCLPL(XS1,YS1,XS0,YS0,VIS) IF (VIS) CALL GRLIN2(XS1, YS1, XS0, YS0) OFF = OFF - 1.0 10 CONTINUE END pgplot/src/pgtikl.f010064400040640000322000000011230632003362600147570ustar00tjpcitmbr00000400000017C.PGTIKL -- length of error bar terminal C SUBROUTINE PGTIKL (T, XL, YL) REAL T, XL, YL C C Return the length of the terminal of an error bar, in world C coordinates. C C Arguments: C T (input) : terminal multiplier C XL (output) : terminal lnegth in world x-coordinates C YL (output) : terminal lnegth in world y-coordinates C-- C 31-Mar-1997 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C XL = T*PGXSP(PGID)*0.15/PGXSCL(PGID) YL = T*PGXSP(PGID)*0.15/PGYSCL(PGID) C END pgplot/src/grmovr.f010064400040640000322000000011400546005547300150100ustar00tjpcitmbr00000400000017 C*GRMOVR -- move pen (relative, world coordinates) C+ SUBROUTINE GRMOVR (DX,DY) C C GRPCKG: move the pen through a specified displacement. C C Arguments: C C DX, DY (real, input): the displacement in world coordinates: the pen C position is incremented by DX in x and DY in y. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL DX,DY C IF (GRCIDE.GE.1) THEN GRXPRE(GRCIDE) = GRXPRE(GRCIDE) + DX*GRXSCL(GRCIDE) GRYPRE(GRCIDE) = GRYPRE(GRCIDE) + DY*GRYSCL(GRCIDE) END IF END pgplot/src/grsetfont.f010064400040640000322000000001730546005550100155040ustar00tjpcitmbr00000400000017C*GRSETFONT -- set text font [obsolete] C SUBROUTINE GRSETFONT (IF) INTEGER IF CALL GRSFNT(IF) END pgplot/src/grmcur.f010064400040640000322000000026030546005547300150000ustar00tjpcitmbr00000400000017 SUBROUTINE GRMCUR (ICH, ICX, ICY) INTEGER ICH, ICX, ICY C C Cursor movement: C Input: ICH character code C In/Out: ICX, ICY cursor position C----------------------------------------------------------------------- INTEGER STEP SAVE STEP DATA STEP /4/ C C Up arrow or keypad 8: IF (ICH.EQ.-1 .OR. ICH.EQ.-28) THEN ICY = ICY+STEP C Down arrow or keypad 2: ELSE IF (ICH.EQ.-2 .OR. ICH.EQ.-22) THEN ICY = ICY-STEP C Right arrow or keypad 6: ELSE IF (ICH.EQ.-3 .OR. ICH.EQ.-26) THEN ICX = ICX+STEP C Left arrow or keypad 4: ELSE IF (ICH.EQ.-4 .OR. ICH.EQ.-24) THEN ICX = ICX-STEP C Keypad 7 (left and up): ELSE IF (ICH.EQ.-27) THEN ICX = ICX-STEP ICY = ICY+STEP C Keypad 9 (right and up): ELSE IF (ICH.EQ.-29) THEN ICX = ICX+STEP ICY = ICY+STEP C Keypad 3 (right and down): ELSE IF (ICH.EQ.-23) THEN ICX = ICX+STEP ICY = ICY-STEP C Keypad 1 (left and down): ELSE IF (ICH.EQ.-21) THEN ICX = ICX-STEP ICY = ICY-STEP C PF1: ELSE IF (ICH.EQ.-11) THEN STEP = 1 C PF2: ELSE IF (ICH.EQ.-12) THEN STEP = 4 C PF3: ELSE IF (ICH.EQ.-13) THEN STEP = 16 C PF4: ELSE IF (ICH.EQ.-14) THEN STEP = 64 END IF END pgplot/src/grmker.f010064400040640000322000000141340634733334700147760ustar00tjpcitmbr00000400000017C*GRMKER -- draw graph markers C+ SUBROUTINE GRMKER (SYMBOL,ABSXY,N,X,Y) C C GRPCKG: Draw a graph marker at a set of points in the current C window. Line attributes (color, intensity, and thickness) C apply to markers, but line-style is ignored. After the call to C GRMKER, the current pen position will be the center of the last C marker plotted. C C Arguments: C C SYMBOL (input, integer): the marker number to be drawn. Numbers C 0-31 are special marker symbols; numbers 32-127 are the C corresponding ASCII characters (in the current font). If the C number is >127, it is taken to be a Hershey symbol number. C If -ve, a regular polygon is drawn. C ABSXY (input, logical): if .TRUE., the input corrdinates (X,Y) are C taken to be absolute device coordinates; if .FALSE., they are C taken to be world coordinates. C N (input, integer): the number of points to be plotted. C X, Y (input, real arrays, dimensioned at least N): the (X,Y) C coordinates of the points to be plotted. C-- C (19-Mar-1983) C 20-Jun-1985 - revise to window markers whole [TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 1-Aug-1988 - add direct use of Hershey number [TJP]. C 15-Dec-1988 - standardize [TJP]. C 17-Dec-1990 - add polygons [PAH/TJP]. C 12-Jun-1992 - [TJP] C 22-Sep-1992 - add support for hardware markers [TJP]. C 1-Sep-1994 - suppress driver call [TJP]. C 15-Feb-1994 - fix bug (expanding viewport!) [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER SYMBOL INTEGER C LOGICAL ABSXY, UNUSED, VISBLE INTEGER I, K, LSTYLE, LX, LY, LXLAST, LYLAST, N, SYMNUM, NV INTEGER XYGRID(300) REAL ANGLE, COSA, SINA, FACTOR, RATIO, X(*), Y(*) REAL XCUR, YCUR, XORG, YORG REAL THETA, XOFF(40), YOFF(40), XP(40), YP(40) REAL XMIN, XMAX, YMIN, YMAX REAL XMINX, XMAXX, YMINX, YMAXX REAL RBUF(4) INTEGER NBUF,LCHR CHARACTER*32 CHR C C Check that there is something to be plotted. C IF (N.LE.0) RETURN C C Check that a device is selected. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRMKER - no graphics device is active.') RETURN END IF C XMIN = GRXMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMIN = GRYMIN(GRCIDE) YMAX = GRYMAX(GRCIDE) XMINX = XMIN-0.01 XMAXX = XMAX+0.01 YMINX = YMIN-0.01 YMAXX = YMAX+0.01 C C Does the device driver do markers (only markers 0-31 at present)? C IF (GRGCAP(GRCIDE)(10:10).EQ.'M' .AND. : SYMBOL.GE.0 .AND. SYMBOL.LE.31) THEN IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C -- symbol number RBUF(1) = SYMBOL C -- scale factor RBUF(4) = GRCFAC(GRCIDE)/2.5 NBUF = 4 LCHR = 0 DO 10 K=1,N C -- convert to device coordinates CALL GRTXY0(ABSXY, X(K), Y(K), XORG, YORG) C -- is the marker visible? CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C) IF (C.EQ.0) THEN RBUF(2) = XORG RBUF(3) = YORG CALL GREXEC(GRGTYP,28,RBUF,NBUF,CHR,LCHR) END IF 10 CONTINUE RETURN END IF C C Otherwise, draw the markers here. C C Save current line-style, and set style "normal". C CALL GRQLS(LSTYLE) CALL GRSLS(1) C C Save current viewport, and open the viewport to include the full C view surface. C CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0) C C Compute scaling and orientation. C ANGLE = 0.0 FACTOR = GRCFAC(GRCIDE)/2.5 RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE) COSA = FACTOR * COS(ANGLE) SINA = FACTOR * SIN(ANGLE) C C Convert the supplied marker number SYMBOL to a symbol number and C obtain the digitization. C IF (SYMBOL.GE.0) THEN IF (SYMBOL.GT.127) THEN SYMNUM = SYMBOL ELSE CALL GRSYMK(SYMBOL,GRCFNT(GRCIDE),SYMNUM) END IF CALL GRSYXD(SYMNUM, XYGRID, UNUSED) C C Positive symbols. C DO 380 I=1,N CALL GRTXY0(ABSXY, X(I), Y(I), XORG, YORG) CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C) IF (C.NE.0) GOTO 380 VISBLE = .FALSE. K = 4 LXLAST = -64 LYLAST = -64 320 K = K+2 LX = XYGRID(K) LY = XYGRID(K+1) IF (LY.EQ.-64) GOTO 380 IF (LX.EQ.-64) THEN VISBLE = .FALSE. ELSE IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN XCUR = XORG + (COSA*LX - SINA*LY)*RATIO YCUR = YORG + (SINA*LX + COSA*LY) IF (VISBLE) THEN CALL GRLIN0(XCUR,YCUR) ELSE GRXPRE(GRCIDE) = XCUR GRYPRE(GRCIDE) = YCUR END IF END IF VISBLE = .TRUE. LXLAST = LX LYLAST = LY END IF GOTO 320 380 CONTINUE C C Negative symbols. C ELSE C ! negative symbol: filled polygon of radius 8 NV = MIN(31,MAX(3,ABS(SYMBOL))) DO 400 I=1,NV THETA = 3.14159265359*(REAL(2*(I-1))/REAL(NV)+0.5) - ANGLE XOFF(I) = COS(THETA)*FACTOR*RATIO/GRXSCL(GRCIDE)*8.0 YOFF(I) = SIN(THETA)*FACTOR/GRYSCL(GRCIDE)*8.0 400 CONTINUE DO 420 K=1,N CALL GRTXY0(ABSXY, X(K), Y(K), XORG, YORG) CALL GRCLIP(XORG, YORG, XMINX, XMAXX, YMINX, YMAXX, C) IF (C.EQ.0) THEN DO 410 I=1,NV XP(I) = X(K)+XOFF(I) YP(I) = Y(K)+YOFF(I) 410 CONTINUE CALL GRFA(NV, XP, YP) END IF 420 CONTINUE END IF C C Set current pen position. C GRXPRE(GRCIDE) = XORG GRYPRE(GRCIDE) = YORG C C Restore the viewport and line-style, and return. C GRXMIN(GRCIDE) = XMIN GRXMAX(GRCIDE) = XMAX GRYMIN(GRCIDE) = YMIN GRYMAX(GRCIDE) = YMAX CALL GRSLS(LSTYLE) C END d. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRMKER - no graphics device is active.') RETURN END IF C XMIN = GRXMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMIN = GRYMIN(GRCIDE) YMAX = GRYMAX(GRCIDE) XMINX = XMIN-0.01 XMAXX = XMAX+0.01 YMINX = YMIN-0.01 YMAXX = YMAX+0.01 C C Does the device driver do markers (only markers 0-31 at present)? C IF (Gpgplot/src/grsetli.f010064400040640000322000000017310546005550100151430ustar00tjpcitmbr00000400000017C*GRSETLI -- *obsolete routine* C+ SUBROUTINE GRSETLI (IN) C C GRPCKG: Set the line intensity for subsequent plotting on the current C device. *** OBSOLETE ROUTINE *** Intensity is now set with GRSCI C and GRSCR. For compatibility, GRSETLI now sets color zero if its C argument is 0, and resets the previous color if its argument is C non-zero. C C Argument: C C IN (integer, input): the intensity to be used for subsequent C plotting on the current device (in range 0-3). C-- C 11-Apr-1983 - [TJP]. C 12-Jul-1984 - modify to call GRSCI [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IN, OLDCOL(GRIMAX) DATA OLDCOL /GRIMAX*1/ C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSETLI - no graphics device is active.') ELSE IF (IN.EQ.0) THEN OLDCOL(GRCIDE) = GRCCOL(GRCIDE) CALL GRSCI(0) ELSE CALL GRSCI(OLDCOL(GRCIDE)) END IF END pgplot/src/pgplot.inc010064400040640000322000000142170630513244100153240ustar00tjpcitmbr00000400000017C----------------------------------------------------------------------- C PGPLOT: common block definition. C----------------------------------------------------------------------- C Maximum number of concurrent devices (should match GRIMAX). C----------------------------------------------------------------------- INTEGER PGMAXD PARAMETER (PGMAXD=8) C----------------------------------------------------------------------- C Indentifier of currently selected device. C----------------------------------------------------------------------- INTEGER PGID C----------------------------------------------------------------------- C Device status (indexed by device identifier). C----------------------------------------------------------------------- C PGDEVS =0 if device is not open; 1 if device is open. C PGADVS Set to 0 by PGBEGIN, set to 1 by PGPAGE; used to suppress C the prompt for the first page. C PROMPT If .TRUE., ask user before clearing page; set by PGASK C and (indirectly) by PGBEGIN, used in PGENV. C PGBLEV Buffering level: incremented by PGBBUF, decremented by C PGEBUF. C PGPFIX TRUE if PGPAP has been called, FALSE otherwise. C INTEGER PGDEVS(PGMAXD), PGADVS(PGMAXD), PGBLEV(PGMAXD) LOGICAL PGPRMP(PGMAXD), PGPFIX(PGMAXD) C----------------------------------------------------------------------- C Panel parameters (indexed by device identification). C----------------------------------------------------------------------- C NX Number of panels in x direction C NY Number of panels in y direction C NXC Ordinal number of current X panel C NYC Ordinal number of current Y panel C XSZ X dimension of panel (device units) C YSZ Y dimension of panel (device units) C PGROWS TRUE if panels are used in row order, FALSE for column C order. C INTEGER PGNX (PGMAXD), PGNY (PGMAXD) INTEGER PGNXC (PGMAXD), PGNYC (PGMAXD) REAL PGXSZ (PGMAXD), PGYSZ (PGMAXD) LOGICAL PGROWS(PGMAXD) C----------------------------------------------------------------------- C Attributes (indexed by device identification). C----------------------------------------------------------------------- C PGCLP clipping enabled/disabed C PGFAS fill-area style C PGCHSZ character height C PGAHS arrow-head fill style C PGAHA arrow-head angle C PGAHV arrow-head vent C PGTBCI text background color index C PGMNCI lower range of color indices available to PGGRAY/PGIMAG C PGMXCI upper range of color indices available to PGGRAY/PGIMAG C PGITF type of transfer function used by PGGRAY/PGIMAG C PGHSA hatching line angle C PGHSS hatching line separation C PGHSP hatching line phase C INTEGER PGCLP (PGMAXD) INTEGER PGFAS (PGMAXD) REAL PGCHSZ(PGMAXD) INTEGER PGAHS (PGMAXD) REAL PGAHA (PGMAXD) REAL PGAHV (PGMAXD) INTEGER PGTBCI(PGMAXD) INTEGER PGMNCI(PGMAXD) INTEGER PGMXCI(PGMAXD) INTEGER PGITF (PGMAXD) REAL PGHSA (PGMAXD) REAL PGHSS (PGMAXD) REAL PGHSP (PGMAXD) C----------------------------------------------------------------------- C Viewport parameters (indexed by device identification); all are device C coordinates: C----------------------------------------------------------------------- C PGXOFF X coordinate of blc of viewport. C PGYOFF Y coordinate of blc of viewport. C PGXVP X coordinate of blc of viewport, relative to blc of subpage. C PGYVP Y coordinate of blc of viewport, relative to blc of subpage. C PGXLEN Width of viewport. C PGYLEN Height of viewport. C REAL PGXOFF(PGMAXD), PGYOFF(PGMAXD) REAL PGXVP (PGMAXD), PGYVP (PGMAXD) REAL PGXLEN(PGMAXD), PGYLEN(PGMAXD) C----------------------------------------------------------------------- C Scaling parameters (indexed by device identification): C----------------------------------------------------------------------- C PGXORG device coordinate value corresponding to world X=0 C PGYORG device coordinate value corresponding to world Y=0 C PGXSCL scale in x (device units per world coordinate unit) C PGYSCL scale in y (device units per world coordinate unit) C PGXPIN device x scale in device units/inch C PGYPIN device y scale in device units/inch C PGXSP Character X spacing (device units) C PGYSP Character Y spacing (device units) C REAL PGXORG(PGMAXD), PGYORG(PGMAXD) REAL PGXSCL(PGMAXD), PGYSCL(PGMAXD) REAL PGXPIN(PGMAXD), PGYPIN(PGMAXD) REAL PGXSP (PGMAXD), PGYSP (PGMAXD) C----------------------------------------------------------------------- C Window parameters (indexed by device identification); all are world C coordinate values: C----------------------------------------------------------------------- C PGXBLC world X at bottom left corner of window C PGXTRC world X at top right corner of window C PGYBLC world Y at bottom left corner of window C PGYTRC world Y at top right corner of window C REAL PGXBLC(PGMAXD), PGXTRC(PGMAXD) REAL PGYBLC(PGMAXD), PGYTRC(PGMAXD) C----------------------------------------------------------------------- C The following parameters are used in the contouring routines to pass C information to the action routine. They do not need to be indexed. C----------------------------------------------------------------------- C TRANS Transformation matrix for contour plots; copied C from argument list by PGCONT and used by PGCP. C INTEGER PGCINT, PGCMIN REAL TRANS(6) CHARACTER*32 PGCLAB C----------------------------------------------------------------------- C----------------------------------------------------------------------- COMMON /PGPLT1/ PGID,PGDEVS,PGADVS,PGNX, PGNY, PGNXC, PGNYC , 1 PGXPIN,PGYPIN,PGXSP, PGYSP, PGXSZ, PGYSZ, 2 PGXOFF,PGYOFF,PGXVP, PGYVP, PGXLEN,PGYLEN,PGXORG,PGYORG, 3 PGXSCL,PGYSCL,PGXBLC,PGXTRC,PGYBLC,PGYTRC,TRANS, 4 PGPRMP,PGCLP, PGFAS, PGCHSZ,PGBLEV,PGROWS, 5 PGAHS, PGAHA, PGAHV, PGTBCI,PGMNCI,PGMXCI,PGCINT,PGCMIN, 6 PGPFIX,PGITF, PGHSA, PGHSS, PGHSP COMMON /PGPLT2/ PGCLAB SAVE /PGPLT1/ SAVE /PGPLT2/ C----------------------------------------------------------------------- status (indexed by device identifier). C----------------------------------------------------------------------- C PGDEVS =0 if device is not open; 1 if device is open. C PGADVS Set to 0 by PGBEGIN, set to 1 by PGPAGE; used to suppress C the prompt for the first page. C PROMPT If .TRUE., ask user before clearing page; set by PGASK C and (indirectly)pgplot/src/grpage.f010064400040640000322000000031120566300136700147400ustar00tjpcitmbr00000400000017C*GRPAGE -- end picture C+ SUBROUTINE GRPAGE C C GRPCKG: Advance the plotting area to a new page. For video devices, C this amounts to erasing the screen; for hardcopy devices, the plot C buffer is written to the output file followed by a form-feed to C advance the paper to the start of the next page. C C Arguments: none. C-- C 3-Jun-1983 - [TJP]. C 18-Feb-1984 - remove unnecessary 'T' initialization of VT125, and add C S(G1) for Rainbow REGIS [TJP]. C 1-Jun-1984 - add type GMFILE [TJP]. C 2-Jul-1984 - change initialization of VT125 for color [TJP]. C 13-Jul-1984 - move initialization of VT125 and Grinnell to GROPEN C [TJP]. C 19-Oct-1984 - add VV device [TJP]. C 29-Jan-1985 - add HP2648 terminal [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - fix GREXEC end picture sequence [AFT]. C 11-Jun-1987 - remove built-in devices [TJP]. C 11-Feb-1992 - update veiew surface size: it may have changed! [TJP]. C 5-Jan-1993 - but only if GRSETS has not been called! [TJP] C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C INTEGER NBUF,LCHR REAL RBUF(6) C CHARACTER CHR C C Flush the buffer. C CALL GRTERM C C Erase the text screen (if there is one). C CALL GRETXT C C End picture. C CALL GREPIC C C Update the view surface size: it may have changed (on windowing C devices) C IF (.NOT.GRADJU(GRCIDE)) THEN CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR) GRXMXA(GRCIDE) = RBUF(2) GRYMXA(GRCIDE) = RBUF(4) END IF C END pgplot/src/grpars.f010064400040640000322000000062570621163437200150040ustar00tjpcitmbr00000400000017C*GRPARS -- parse device specification string C+ INTEGER FUNCTION GRPARS (SPEC,DEV,TYPE,APPEND) CHARACTER*(*) SPEC, DEV INTEGER TYPE LOGICAL APPEND C C GRPCKG: decode a device-specification; called by GROPEN. C C Returns: C GRPARS (output): 1 if the device-specification is C acceptable; any other value indicates an error. C C Arguments: C SPEC (input): the device specification. C DEV (output): device name or file spec. C TYPE (output): device type (integer code); 0 if no device C type is specified. C APPEND (output): .TRUE. if /APPEND specified, .FALSE. otherwise. C-- C 23-Jul-1984 - [TJP]. C 19-Feb-1988 - allow device part to be quoted [TJP]. C 30-Mar-1989 - remove logical translation of device and type [TJP]. C 17-Jun-1991 - ignore comments after ' (' [TJP]. C 19-Dec-1994 - rewritten to scan backwards [TJP]. C 6-Jun-1995 - correct a zero-length string problem [TJP]. C----------------------------------------------------------------------- CHARACTER*32 CTYPE, UPPER CHARACTER*6 APPSTR CHARACTER*256 DESCR INTEGER GRDTYP, GRTRIM INTEGER L, LC, LS DATA APPSTR/'APPEND'/ C C Default results. C DEV = ' ' TYPE = 0 APPEND = .FALSE. GRPARS = 1 CTYPE = ' ' C C Null string is acceptable. C IF (LEN(SPEC).LT.1) RETURN IF (SPEC.EQ.' ') RETURN C C On systems where it is possible, perform a "logical name" translation. C DESCR = SPEC CALL GRLGTR(DESCR) C C Discard trailing blanks: L is length of remainder. C L = GRTRIM(DESCR) C C Find last slash in string (position LS or 0). C LS = L 20 IF (DESCR(LS:LS).NE.'/') THEN LS = LS-1 IF (LS.GT.0) GOTO 20 END IF C C Check for /APPEND qualifier; if present, look again for type. C IF (LS.GT.0) THEN CTYPE = DESCR(LS+1:L) CALL GRTOUP(UPPER,CTYPE) CTYPE = UPPER IF (CTYPE.EQ.APPSTR) THEN APPEND = .TRUE. L = LS-1 LS = L 30 IF (DESCR(LS:LS).NE.'/') THEN LS = LS-1 IF (LS.GT.0) GOTO 30 END IF ELSE APPEND = .FALSE. END IF END IF C C If LS=0 there is no type field: use PGPLOT_TYPE. C IF (LS.EQ.0) THEN CALL GRGENV('TYPE', CTYPE, LC) ELSE CTYPE = DESCR(LS+1:L) LC = L-LS L = LS-1 END IF C C Check for allowed type. C IF (LC.GT.0) THEN CALL GRTOUP(UPPER,CTYPE) CTYPE = UPPER TYPE = GRDTYP(CTYPE) IF (TYPE.EQ.0) CALL GRWARN('Unrecognized device type') IF (TYPE.EQ.-1) CALL GRWARN('Device type is ambiguous') ELSE TYPE = 0 CALL GRWARN('Device type omitted') END IF IF (TYPE.EQ.0) GRPARS = GRPARS+2 C C Remove quotes from device if necessary. C IF (L.GE.1) THEN IF (DESCR(1:1).EQ.'"' .AND. DESCR(L:L).EQ.'"') THEN DEV = DESCR(2:L-1) L = L-2 ELSE DEV = DESCR(1:L) END IF END IF C C write (*,*) 'Device = [', DEV(1:L), ']' C write (*,*) 'Type = [', CTYPE, ']', TYPE C write (*,*) 'APPEND = ', APPEND C END pgplot/src/grquit.f010064400040640000322000000010230566124646200150120ustar00tjpcitmbr00000400000017C*GRQUIT -- report a fatal error and abort execution C+ SUBROUTINE GRQUIT (TEXT) CHARACTER*(*) TEXT C C Report a fatal error (via GRWARN) and exit program. C This routine should be called in the event of an unrecoverable C PGPLOT error. C C Argument: C TEXT (input): text of message to be sent to GRWARN. C-- C 12-Nov-1994 C----------------------------------------------------------------------- C CALL GRWARN(TEXT) CALL GRWARN('Fatal error in PGPLOT library: program terminating.') STOP END pgplot/src/grpixl.f010064400040640000322000000126070610150326300147770ustar00tjpcitmbr00000400000017C*GRPIXL -- solid-fill multiple rectangular areas C+ SUBROUTINE GRPIXL (IA, IDIM, JDIM, I1, I2, J1, J2, 1 X1, X2, Y1, Y2) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL X1, X2, Y1, Y2 C C Determine the size of each rectangular element. If it is equal C to the device pen width and the device supports pixel primitives, C use pixel primitives. Otherwise, if the size is smaller than the C device pen width emulate pixel output by plotting points. If the C size is larger than the device pen width, emulate by outputting C solid-filled rectangles. C C Arguments: C IA (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C X1, Y1 (input) : world coordinates of one corner of the output C region C X2, Y2 (input) : world coordinates of the opposite corner of the C output region C-- C 18-Jan-1991 - [Ge van Geldorp] C 31-Mar-1993 - Include color PostScript GRPXPS [Remko Scharroo] C 4-Apr-1993 - New version of GRPXPS incorporated C 4-Aug-1993 - Debugging C 7-Sep-1994 - Revised for v5.0 [TJP]. C 24-Jan-1996 - GRXMIN etc changed to REAL as required in grpckg1.inc [RS] C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(3) INTEGER NBUF, LCHR CHARACTER*32 CHR REAL XLL, YLL, XUR, YUR REAL XMIN, YMIN, XMAX, YMAX, XPIX, YPIX REAL WIDTH, XSIZE, YSIZE INTEGER IL, IR, JB, JT C IF (GRCIDE.LT.1) RETURN C C Convert to device coordinates C CALL GRTXY0(.FALSE., X1, Y1, XLL, YLL) CALL GRTXY0(.FALSE., X2, Y2, XUR, YUR) XMIN = MIN(XLL,XUR) XMAX = MAX(XLL,XUR) YMIN = MIN(YLL,YUR) YMAX = MAX(YLL,YUR) C C Check if completely outside clipping region C IF (XMAX .LT. GRXMIN(GRCIDE) .OR. GRXMAX(GRCIDE) .LT. XMIN .OR. 1 YMAX .LT. GRYMIN(GRCIDE) .OR. GRYMAX(GRCIDE) .LT. YMIN) 2 RETURN C C Don't paint "pixels" completely before left clipping boundary C XPIX = XMAX - XMIN YPIX = YMAX - YMIN IF (XMIN .LT. GRXMIN(GRCIDE)) THEN IL = I1 + (GRXMIN(GRCIDE) - XMIN) * (I2 - I1 + 1) / XPIX XMIN = XMIN + (XPIX * (IL - I1)) / (I2 - I1 + 1) ELSE IL = I1 ENDIF C C Don't paint "pixels" completely after right clipping boundary C IF (GRXMAX(GRCIDE) .LT. XMAX) THEN IR = I2 - (XMAX - GRXMAX(GRCIDE)) * (I2 - I1 + 1) / XPIX + 1 XMAX = XMIN + (XPIX * (IR - I1 + 1)) / 1 (I2 - I1 + 1) ELSE IR = I2 ENDIF C C Don't paint "pixels" completely under bottom clipping boundary C IF (YMIN .LT. GRYMIN(GRCIDE)) THEN JB = J1 + (GRYMIN(GRCIDE) - YMIN) * (J2 - J1 + 1) / YPIX YMIN = YMIN + (YPIX * (JB - J1)) / (J2 - J1 + 1) ELSE JB = J1 ENDIF C C Don't paint "pixels" completely above top clipping boundary C IF (GRYMAX(GRCIDE) .LT. YMAX) THEN JT = J2 - (YMAX - GRYMAX(GRCIDE)) * (J2 - J1 + 1) / YPIX + 1 YMAX = YMIN + (YPIX * (JT - J1 + 1)) / 1 (J2 - J1 + 1) ELSE JT = J2 ENDIF C C If device accepts image primitives, use GRPXPS C IF (GRGCAP(GRCIDE)(7:7).EQ.'Q') THEN CALL GRPXPS(IA, IDIM, JDIM, IL, IR, JB, JT, 1 XMIN,XMAX,YMIN,YMAX) RETURN ENDIF C C Check against pen width C CALL GREXEC(GRGTYP, 3, RBUF, NBUF, CHR, LCHR) WIDTH = RBUF(3) XSIZE = (I2 - I1 + 1) * WIDTH YSIZE = (J2 - J1 + 1) * WIDTH XPIX = XMAX - XMIN + 1 YPIX = YMAX - YMIN + 1 C C Use rectangles if "pixel" is too large C IF (XPIX .GT. XSIZE + 0.5 * WIDTH .OR. 1 YPIX .GT. YSIZE + 0.5 * WIDTH) THEN * write (6,*) 'GRPXRE' CALL GRPXRE(IA, IDIM, JDIM, IL, IR, JB, JT, 1 XMIN, XMAX, YMIN, YMAX) C C Use either pixel primitives or points C ELSE C C Clip pixels lying more than 50% outside clipping boundaries C IF (XMIN .LT. GRXMIN(GRCIDE) - 0.5 * WIDTH) THEN XMIN = XMIN + XPIX / (IR - IL + 1) IL = IL + 1 ENDIF IF (GRXMAX(GRCIDE) + 0.5 * WIDTH .LT. XMAX) THEN XMAX = XMAX - XPIX / (IR - IL + 1) IR = IR - 1 ENDIF IF (YMIN .LT. GRYMIN(GRCIDE) - 0.5 * WIDTH) THEN YMIN = YMIN + YPIX / (JT - JB + 1) JB = JB + 1 ENDIF IF (GRYMAX(GRCIDE) + 0.5 * WIDTH .LT. YMAX) THEN YMAX = YMAX - YPIX / (JT - JB + 1) JT = JT - 1 ENDIF C C Recalculate size C XSIZE = (IR - IL + 1) * WIDTH YSIZE = (JT - JB + 1) * WIDTH XPIX = XMAX - XMIN + 1 YPIX = YMAX - YMIN + 1 C C Use pixel primitives if available and possible C IF (GRGCAP(GRCIDE)(7:7) .EQ. 'P' .AND. 1 XSIZE - 0.5 * WIDTH .LE. XPIX .AND. 2 YSIZE - 0.5 * WIDTH .LE. YPIX) THEN * write (6,*) 'GRPXPX' CALL GRPXPX(IA, IDIM, JDIM, IL, IR, JB, JT, XMIN, YMIN) C C Otherwise, use points C ELSE * write (6,*) 'GRPXPO' CALL GRPXPO(IA, IDIM, JDIM, IL, IR, JB, JT, 1 XMIN, XMAX, YMIN, YMAX) ENDIF ENDIF END pgplot/src/grpxpo.f010064400040640000322000000027700546005547500150270ustar00tjpcitmbr00000400000017C*GRPXPO -- Emulate pixel operations using points C+ SUBROUTINE GRPXPO (IA, IDIM, JDIM, I1, I2, J1, J2, 1 X1, X2, Y1, Y2) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL X1, X2, Y1, Y2 C C Arguments: C IA (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C X1, X2 (input) : the horizontal range of the output region C Y1, Y2 (input) : the vertical range of the output region C-- C 16-Jan-1991 - [GvG] C 28-Jun-1991 C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER LW INTEGER I, J INTEGER ICOL, LSTCOL C C Save attributes C CALL GRQLW(LW) CALL GRQCI(ICOL) CALL GRSLW(1) LSTCOL = ICOL DO 20 J = J1, J2 DO 10 I = I1, I2 C C Color changed? C IF (IA(I, J) .NE. LSTCOL) THEN CALL GRSCI(IA(I, J)) LSTCOL = IA(I, J) ENDIF C C Output dot C CALL GRDOT0(X1 + (X2 - X1) * (I - I1 + 0.5) / (I2 - I1 + 1), 1 Y1 + (Y2 - Y1) * (J - J1 + 0.5) / (J2 - J1 + 1)) 10 CONTINUE 20 CONTINUE C C Restore attributes C CALL GRSCI(ICOL) CALL GRSLW(LW) END pgplot/src/grpxpx.f010064400040640000322000000040650563345536300150410ustar00tjpcitmbr00000400000017 C*GRPXPX -- Perform pixel operations using pixel primitive C+ SUBROUTINE GRPXPX (IA, IDIM, JDIM, I1, I2, J1, J2, X, Y) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL X, Y C C Arguments: C IA (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C X, Y (input) : the lower left corner of the output region C (device coordinates) C-- C 16-Jan-1991 - [GvG] * 4-Aug-1993 - Debugged by Remko Scharroo C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NSIZE PARAMETER (NSIZE = 1280) REAL RBUF(NSIZE + 2) REAL WIDTH INTEGER IC1, IC2 INTEGER I, J, L INTEGER NBUF, LCHR CHARACTER*1 CHR IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C C Get allowable color range and pixel width C CALL GRQCOL(IC1, IC2) CALL GREXEC(GRGTYP, 3, RBUF, NBUF, CHR, LCHR) WIDTH = RBUF(3) DO 30 J = J1, J2 C C Compute Y coordinate for this line C RBUF(2) = Y + (J - J1) * WIDTH I = I1 10 L = 1 C C Compute left X coordinate for this line segment C RBUF(1) = X + (I - I1) * WIDTH C C Check color index C 20 IF (IA(I, J) .LT. IC1 .OR. IC2 .LT. IA(I, J)) THEN RBUF(L + 2) = 1 ELSE RBUF(L + 2) = IA(I, J) ENDIF L = L + 1 I = I + 1 C C Still room in segment and something left? C IF (L .LE. NSIZE .AND. I .LE. I2) GOTO 20 C C Output segment C * NBUF = L + 2 ! wrong ! should be: (RS) NBUF = L + 1 CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) C C Something left? C IF (I .LE. I2) GOTO 10 30 CONTINUE END pgplot/src/grpxre.f010064400040640000322000000031310546005547500150070ustar00tjpcitmbr00000400000017C*GRPXRE -- Emulate pixel operations using rectangles C+ SUBROUTINE GRPXRE (IA, IDIM, JDIM, I1, I2, J1, J2, 1 X1, X2, Y1, Y2) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL X1, X2, Y1, Y2 C C Arguments: C IA (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C X1, X2 (input) : the horizontal range of the output region C Y1, Y2 (input) : the vertical range of the output region C-- C 18-Jan-1991 - [GvG] C----------------------------------------------------------------------- REAL YB, YT INTEGER I, J, ICOL, LSTCOL C C Save color attribute C CALL GRQCI(ICOL) LSTCOL = ICOL DO 20 J = J1, J2 C C Compute Y range for this index C YB = Y1 + ((Y2 - Y1) * (J - J1)) / (J2 - J1 + 1) YT = Y1 + ((Y2 - Y1) * (J - J1 + 1)) / (J2 - J1 + 1) DO 10 I = I1, I2 C C Need to change color? C IF (IA(I, J) .NE. LSTCOL) THEN CALL GRSCI(IA(I, J)) LSTCOL = IA(I, J) ENDIF C C Output rectangle C CALL GRREC0(X1 + ((X2 - X1) * (I - I1)) / (I2 - I1 + 1), YB, 1 X1 + ((X2 - X1) * (I - I1 + 1)) / (I2 - I1 + 1), 2 YT) 10 CONTINUE 20 CONTINUE C C Restore color attribute C CALL GRSCI(ICOL) END pgplot/src/grqcap.f010064400040640000322000000012630563142105300147460ustar00tjpcitmbr00000400000017C*GRQCAP -- inquire device capabilities C+ SUBROUTINE GRQCAP (STRING) CHARACTER*(*) STRING C C GRPCKG: obtain the "device capabilities" string from the device C driver for the current device. C C Arguments: C C STRING (output, CHARACTER*(*)): receives the device capabilities C string. C-- C 26-Nov-92: new routine [TJP]. C 1-Sep-94: get from common instead of driver [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQCAP - no graphics device is active.') STRING = 'NNNNNNNNNN' ELSE STRING = GRGCAP(GRCIDE) END IF C END pgplot/src/grqci.f010064400040640000322000000010160546005547500146050ustar00tjpcitmbr00000400000017C*GRQCI -- inquire current color index C+ SUBROUTINE GRQCI (C) C C GRPCKG: obtain the color index of the current graphics device. C C Argument: C C C (integer, output): receives the current color index (0-255). C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER C C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQCI - no graphics device is active.') C = 1 ELSE C = GRCCOL(GRCIDE) END IF END pgplot/src/grqcol.f010064400040640000322000000016550563145040100147640ustar00tjpcitmbr00000400000017C*GRQCOL -- inquire color capability C+ SUBROUTINE GRQCOL (CI1, CI2) INTEGER CI1, CI2 C C Query the range of color indices available on the current device. C C Argument: C CI1 (output) : the minimum available color index. This will be C either 0 if the device can write in the C background color, or 1 if not. C CI2 (output) : the maximum available color index. This will be C 1 if the device has no color capability, or a C larger number (e.g., 3, 7, 15, 255). C-- C 31-May-1989 - new routine [TJP]. C 1-Sep-1994 - avoid driver call [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C C Error if no workstation is open. C IF (GRCIDE.LT.1) THEN CI1 = 0 CI2 = 0 ELSE CI1 = GRMNCI(GRCIDE) CI2 = GRMXCI(GRCIDE) END IF C END pgplot/src/grqcr.f010064400040640000322000000032360563365706300146270ustar00tjpcitmbr00000400000017C*GRQCR -- inquire color representation C+ SUBROUTINE GRQCR (CI, CR, CG, CB) INTEGER CI REAL CR, CG, CB C C Return the color representation (red, green, blue intensities) C currently associated with the specified color index. This may be C different from that requested on some devices. C C Arguments: C C CI (integer, input): color index. C CR, CG, CB (real, output): red, green, and blue intensities, C in range 0.0 to 1.0. C-- C 7-Sep-1994 - rewrite [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF, LCHR, K REAL RBUF(6) CHARACTER CHR C CR = 1.0 CG = 1.0 CB = 1.0 K = CI IF (GRCIDE.LT.1) THEN C -- no device open: return white CALL GRWARN('GRQCR: no plot device is open.') ELSE IF (GRGCAP(GRCIDE)(9:9).NE.'Y') THEN C -- devices that don't allow query color representation: C return black for ci 0, white for all others IF (K.EQ.0) THEN CR = 0.0 CG = 0.0 CB = 0.0 END IF ELSE C -- query device driver; treat invalid ci as 1 IF (K.LT.GRMNCI(GRCIDE) .OR. CI.GT.GRMXCI(GRCIDE)) THEN CALL GRWARN('GRQCR: invalid color index.') K = 1 END IF RBUF(1) = K NBUF = 1 LCHR = 0 CALL GREXEC(GRGTYP,29,RBUF,NBUF,CHR,LCHR) IF (NBUF.LT.4) THEN CALL GRWARN('GRSCR: device driver error') ELSE CR = RBUF(2) CG = RBUF(3) CB = RBUF(4) END IF END IF C END pgplot/src/grqdev.f010064400040640000322000000012640546005547600147760ustar00tjpcitmbr00000400000017 C*GRQDEV -- inquire current device C+ SUBROUTINE GRQDEV (DEVICE, L) CHARACTER*(*) DEVICE INTEGER L C C Obtain the name of the current graphics device or file. C C Argument: C DEVICE (output): receives the device name of the C currently active device. C L (output): number of characters in DEVICE, excluding trailing C blanks. C-- C 19-Feb-1988 C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C IF (GRCIDE.LT.1) THEN DEVICE = '?' L = 1 ELSE DEVICE = GRFILE(GRCIDE) L = GRFNLN(GRCIDE) IF (L.GT.LEN(DEVICE)) L = LEN(DEVICE) END IF END pgplot/src/grqdt.f010064400040640000322000000020700546005547600146230ustar00tjpcitmbr00000400000017 C*GRQDT -- inquire current device and type C+ SUBROUTINE GRQDT (DEVICE) C C GRPCKG: obtain the name and type of the current graphics device. C C Argument: C C DEVICE (output, character): receives the device name and type of the C currently active device in the form 'device/type'; this is a C valid string for input to GROPEN. C-- C 1-Feb-1983 C 19-Feb-1988 - add quotes if necessary. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' CHARACTER*(*) DEVICE CHARACTER*14 TYPE LOGICAL JUNK INTEGER L C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQDT - no graphics device is active.') DEVICE = '/NULL' ELSE CALL GRQTYP(TYPE,JUNK) L = GRFNLN(GRCIDE) IF (L.LE.0) THEN DEVICE = '/'//TYPE ELSE IF (INDEX(GRFILE(GRCIDE)(1:L), '/').EQ.0) THEN DEVICE = GRFILE(GRCIDE)(1:L)//'/'//TYPE ELSE DEVICE = '"'//GRFILE(GRCIDE)(1:L)//'"/'//TYPE END IF END IF END pgplot/src/grqfnt.f010064400040640000322000000010610546005547600150020ustar00tjpcitmbr00000400000017C*GRQFNT -- inquire current font C+ SUBROUTINE GRQFNT (IF) C C GRPCKG: obtain the font number of the current graphics device. C C Argument: C C IF (integer, output): receives the current font number (1-3). C-- C (19-Mar-1983) C 15-Dec-1988 - change name [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IF C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQFNT - no graphics device is active.') IF = 1 ELSE IF = GRCFNT(GRCIDE) END IF END pgplot/src/grqls.f010064400040640000322000000010300546005547700146260ustar00tjpcitmbr00000400000017 C*GRQLS -- inquire current line-style C+ SUBROUTINE GRQLS (ISTYLE) INTEGER ISTYLE C C GRPCKG: obtain the line-style of the current graphics device. C C Argument: C ISTYLE (output): receives the current line-style code. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQLS - no graphics device is active.') ISTYLE = 1 ELSE ISTYLE = GRSTYL(GRCIDE) END IF END pgplot/src/grqlw.f010064400040640000322000000010270571375727200146430ustar00tjpcitmbr00000400000017C*GRQLW -- inquire current line width C+ SUBROUTINE GRQLW (IWIDTH) INTEGER IWIDTH C C GRPCKG: obtain the line-width of the current graphics device. C C Argument: C IWIDTH (output): receives the current line-width. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQLW - no graphics device is active.') IWIDTH = 1 ELSE IWIDTH = ABS(GRWIDT(GRCIDE)) END IF END pgplot/src/grqpos.f010064400040640000322000000011320546005547700150140ustar00tjpcitmbr00000400000017C*GRQPOS -- return current pen position (absolute, world coordinates) C+ SUBROUTINE GRQPOS(X,Y) C C GRQPOS: returns the current pen position in absolute, world C coordinates. C C Arguments: C C X, Y (real, output): world coordinates of the pen position. C-- C 1-Mar-1991 - new routine [JM]. C----------------------------------------------------------------------- REAL X,Y INCLUDE 'grpckg1.inc' C IF (GRCIDE.GE.1) THEN X = (GRXPRE(GRCIDE) - GRXORG(GRCIDE)) / GRXSCL(GRCIDE) Y = (GRYPRE(GRCIDE) - GRYORG(GRCIDE)) / GRYSCL(GRCIDE) END IF END pgplot/src/grqtxt.f010064400040640000322000000103650634733337700150450ustar00tjpcitmbr00000400000017C*GRQTXT -- get text bounding box C+ SUBROUTINE GRQTXT (ORIENT,X0,Y0,STRING, XBOX, YBOX) C C GRPCKG: get the bounding box of a string drawn by GRTEXT. C-- C 12-Sep-1993 - [TJP]. C 8-Nov-1994 - return something even if string is blank [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL UNUSED, VISBLE, PLOT INTEGER XYGRID(300) INTEGER LIST(256) CHARACTER*(*) STRING REAL XBOX(4), YBOX(4) REAL ANGLE, FACTOR, FNTBAS, FNTFAC, COSA, SINA, DX, DY, XORG, YORG REAL ORIENT, RATIO, X0, Y0, RLX, RLY REAL XG, YG, XGMIN, XGMAX, YGMIN, YGMAX INTEGER I, IFNTLV,NLIST,LX,LY, K, LXLAST,LYLAST INTRINSIC ABS, COS, LEN, MAX, MIN, SIN C C Default return values. C DO 10 I=1,4 XBOX(I) = X0 YBOX(I) = Y0 10 CONTINUE C C Check that there is something to be plotted. C IF (LEN(STRING).LE.0) RETURN C C Check that a device is selected. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQTXT - no graphics device is active.') RETURN END IF C XORG = GRXPRE(GRCIDE) YORG = GRYPRE(GRCIDE) C C Compute scaling and orientation. C ANGLE = ORIENT*(3.14159265359/180.) FACTOR = GRCFAC(GRCIDE)/2.5 RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE) COSA = FACTOR * COS(ANGLE) SINA = FACTOR * SIN(ANGLE) XORG = X0 YORG = Y0 C C Convert the string to a list of symbol numbers; to prevent overflow C of array LIST, the length of STRING is limited to 256 characters. C CALL GRSYDS(LIST,NLIST,STRING(1:MIN(256,LEN(STRING))), 1 GRCFNT(GRCIDE)) C C Run through the string of characters, getting bounding box C in character coordinates. (XG, YG) is the starting point C of the current character. The x/y limits of the bbox are C XGMIN...XGMAX, YGMIN...YGMAX. C FNTBAS = 0.0 FNTFAC = 1.0 IFNTLV = 0 DX = 0.0 DY = 0.0 XG = 0.0 YG = 0.0 XGMIN = 1E30 XGMAX = -1E30 YGMIN = 1E30 YGMAX = -1E30 PLOT = .FALSE. DO 380 I=1,NLIST IF (LIST(I).LT.0) THEN IF (LIST(I).EQ.-1) THEN C ! up IFNTLV = IFNTLV+1 FNTBAS = FNTBAS + 16.0*FNTFAC FNTFAC = 0.75**ABS(IFNTLV) ELSE IF (LIST(I).EQ.-2) THEN C ! down IFNTLV = IFNTLV-1 FNTFAC = 0.75**ABS(IFNTLV) FNTBAS = FNTBAS - 16.0*FNTFAC ELSE IF (LIST(I).EQ.-3) THEN C ! backspace XG = XG - DX*FNTFAC END IF GOTO 380 END IF CALL GRSYXD(LIST(I),XYGRID,UNUSED) VISBLE = .FALSE. DX = XYGRID(5)-XYGRID(4) K = 4 LXLAST = -64 LYLAST = -64 320 K = K+2 LX = XYGRID(K) LY = XYGRID(K+1) IF (LY.EQ.-64) GOTO 330 IF (LX.EQ.-64) THEN VISBLE = .FALSE. ELSE RLX = (LX - XYGRID(4))*FNTFAC RLY = (LY - XYGRID(2))*FNTFAC + FNTBAS IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN XGMIN = MIN(XGMIN,XG+RLX) XGMAX = MAX(XGMAX,XG+RLX) YGMIN = MIN(YGMIN,RLY) YGMAX = MAX(YGMAX,RLY) PLOT = .TRUE. END IF VISBLE = .TRUE. LXLAST = LX LYLAST = LY END IF GOTO 320 330 XG = XG + DX*FNTFAC 380 CONTINUE C C Check whether anything was plotted. C IF (.NOT.PLOT) RETURN C C Expand the box a bit to allow for line-width. C XGMIN = XGMIN - 5.0 XGMAX = XGMAX + 5.0 YGMIN = YGMIN - 4.0 YGMAX = YGMAX + 4.0 C C Convert bounding box to device coordinates. C C WRITE (*,*) XGMIN, XGMAX, YGMIN, YGMAX XBOX(1) = XORG + (COSA*XGMIN - SINA*YGMIN)*RATIO YBOX(1) = YORG + (SINA*XGMIN + COSA*YGMIN) XBOX(2) = XORG + (COSA*XGMIN - SINA*YGMAX)*RATIO YBOX(2) = YORG + (SINA*XGMIN + COSA*YGMAX) XBOX(3) = XORG + (COSA*XGMAX - SINA*YGMAX)*RATIO YBOX(3) = YORG + (SINA*XGMAX + COSA*YGMAX) XBOX(4) = XORG + (COSA*XGMAX - SINA*YGMIN)*RATIO YBOX(4) = YORG + (SINA*XGMAX + COSA*YGMIN) C END pgplot/src/grqtyp.f010064400040640000322000000025200563142124500150170ustar00tjpcitmbr00000400000017C*GRQTYP -- inquire current device type C+ SUBROUTINE GRQTYP (TYPE,INTER) CHARACTER*(*) TYPE LOGICAL INTER C C GRPCKG: obtain the device type of the currently selected graphics C device, and determine whether or not it is an interactive device. C C Arguments: C C TYPE (output, CHARACTER*(*)): receives the device type, as a C character string, eg 'PRINTRONIX', 'TRILOG', 'VERSATEC', C 'TEK4010', 'TEK4014', 'GRINNELL', or 'VT125'. The character C string should have a length of at least 8 to ensure that the C type is unique. C INTER (output, LOGICAL): receives the value .TRUE. if the device is C interactive, .FALSE. otherwise. C-- C (23-May-1983) C 5-Aug-1986 - add GREXEC support [AFT]. C 18-Jan-1993 - return type only, not description [TJP]. C 1-Sep-1994 - get capabilities from common [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER*32 CHR C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRQTYP - no graphics device is active.') TYPE = 'NULL' INTER = .FALSE. ELSE CALL GREXEC(GRGTYP, 1,RBUF,NBUF,CHR,LCHR) LCHR = INDEX(CHR,' ') TYPE = CHR(:LCHR) INTER = (GRGCAP(GRCIDE)(1:1).EQ.'I') END IF C END pgplot/src/grrect.f010064400040640000322000000021450546005550000147570ustar00tjpcitmbr00000400000017 C*GRRECT -- fill a rectangle C+ SUBROUTINE GRRECT (X0,Y0,X1,Y1) REAL X0, Y0, X1, Y1 C C GRPCKG: Fill a rectangle with solid color. The rectangle C is defined by the (x,y) world coordinates of its lower left and upper C right corners; the edges are parallel to the coordinate axes. C C Arguments: C C X0, Y0 (input, real): world coordinates of one corner of the C rectangle. C X1, Y1 (input, real): world coordinates of the opposite corner of the C rectangle. C-- C 23-Mar-1988 - [TJP]. C 18-Jan-1991 - Code moved from GRRECT to GRREC0 so that it can also be C used by GRPXRE C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL XLL, YLL, XUR, YUR REAL XMIN, YMIN, XMAX, YMAX C IF (GRCIDE.LT.1) RETURN C C Convert to device coordinates and clip. C CALL GRTXY0(.FALSE.,X0,Y0,XLL,YLL) CALL GRTXY0(.FALSE.,X1,Y1,XUR,YUR) XMIN = MIN(XLL,XUR) XMAX = MAX(XLL,XUR) YMIN = MIN(YLL,YUR) YMAX = MAX(YLL,YUR) C C Do the real work C CALL GRREC0(XMIN,YMIN,XMAX,YMAX) END pgplot/src/grsci.f010064400040640000322000000047770563145127400146250ustar00tjpcitmbr00000400000017C*GRSCI -- set color index C+ SUBROUTINE GRSCI (IC) C C GRPCKG: Set the color index for subsequent plotting. Calls to GRSCI C are ignored for monochrome devices. The default color index is 1, C usually white on a black background for video displays or black on a C white background for printer plots. The color index is an integer in C the range 0 to a device-dependent maximum. Color index 0 corresponds C to the background color; lines may be "erased" by overwriting them C with color index 0. C C Color indices 0-7 are predefined as follows: 0 = black (background C color), 1 = white (default), 2 = red, 3 = green, 4 = blue, 5 = cyan C (blue + green), 6 = magenta (red + blue), 7 = yellow (red + green). C The assignment of colors to color indices can be changed with C subroutine GRSCR (set color representation). C C Argument: C C IC (integer, input): the color index to be used for subsequent C plotting on the current device (in range 0-255). If the C index exceeds the device-dependent maximum, the result is C device-dependent. C-- C 11-Apr-1983 - [TJP]. C 3-Jun-1984 - add GMFILE device [TJP]. C 13-Jun-1984 - add code for TK4100 devices [TJP]. C 2-Jul-1984 - add code for RETRO and VT125 (REGIS) devices [TJP]. C 2-Oct-1984 - change REGIS to improve VT240 behavior [TJP]. C 22-Dec-1984 - add PRTX, TRILOG, VERS and VV devices [TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - delays setting color if picture not open [AFT]. C 11-Jun-1987 - remove built-in devices [TJP]. C 31-May-1989 - add check for valid color index [TJP]. C 1-Sep-1994 - use common data [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IC, COLOR, IC1, IC2, NBUF,LCHR REAL RBUF(6) CHARACTER*1 CHR C C Error if no workstation is open. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSCI - no graphics device is active.') RETURN END IF C C Use color index 1 if out of range. C IC1 = GRMNCI(GRCIDE) IC2 = GRMXCI(GRCIDE) COLOR = IC IF (COLOR.LT.IC1 .OR. COLOR.GT.IC2) COLOR = 1 C C If no change to color index is requested, take no action. C IF (COLOR.EQ.GRCCOL(GRCIDE)) RETURN C C If the workstation is in "picture open" state, send command to C driver. C IF (GRPLTD(GRCIDE)) THEN RBUF(1) = COLOR CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR) END IF C C Set the current color index. C GRCCOL(GRCIDE)=COLOR C END epgplot/src/grsls.f010064400040640000322000000047260563141567300146450ustar00tjpcitmbr00000400000017C*GRSLS -- set line style C+ SUBROUTINE GRSLS (IS) INTEGER IS C C GRPCKG: Set the line style for subsequent plotting on the current C device. The different line styles are generated in hardware on C some devices and by GRPCKG software for the other devices. Five C different line styles are available, with the following codes: C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted), C 5 (dash-dot-dot-dot). The default is 1 (normal full line). Line C style is ignored when drawing characters, which are always drawn with C a full line. C C Argument: C C IS (input, integer): the line-style code for subsequent plotting on C the current device (in range 1-5). C-- C 9-Feb-1983 - [TJP]. C 3-Jun-1984 - add GMFILE device [TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - If needed, calls begin picture [AFT]. C 19-Jan-1987 - fix bug in GREXEC call [TJP]. C 16-May-1989 - fix bug for hardware line dash [TJP]. C 1-Sep-1994 - do not call driver to get size and capabilities [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I, L, IDASH, NBUF,LCHR REAL RBUF(6),TMP CHARACTER*10 CHR REAL PATERN(8,5) C DATA PATERN/ 8*10.0, 1 8*10.0, 2 8.0, 6.0, 1.0, 6.0, 8.0, 6.0, 1.0, 6.0, 3 1.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0, 4 8.0, 6.0, 1.0, 6.0, 1.0, 6.0, 1.0, 6.0 / C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSLS - no graphics device is active.') RETURN END IF C I = IS IF (I.LT.1 .OR. I.GT.5) THEN CALL GRWARN('GRSLS - invalid line-style requested.') I = 1 END IF C C Inquire if hardware dash is available. C IDASH=0 IF(GRGCAP(GRCIDE)(3:3).EQ.'D') IDASH=1 C C Set up for hardware dash. C IF(IDASH.NE.0) THEN GRDASH(GRCIDE) = .FALSE. IF (GRPLTD(GRCIDE)) THEN RBUF(1)=I NBUF=1 CALL GREXEC(GRGTYP,19,RBUF,NBUF,CHR,LCHR) END IF C C Set up for software dash. C ELSE IF (I.EQ.1) THEN GRDASH(GRCIDE) = .FALSE. ELSE GRDASH(GRCIDE) = .TRUE. GRIPAT(GRCIDE) = 1 GRPOFF(GRCIDE) = 0.0 TMP = GRYMXA(GRCIDE)/1000. DO 10 L=1,8 GRPATN(GRCIDE,L) = PATERN(L,I)*TMP 10 CONTINUE END IF END IF GRSTYL(GRCIDE) = I END pgplot/src/grsetc.f010064400040640000322000000014770546005550000147670ustar00tjpcitmbr00000400000017 C*GRSETC -- set character size C+ SUBROUTINE GRSETC (IDENT,XSIZE) C C GRPCKG : change the character size (user-callable routine). C C Input: IDENT : plot identifier C XSIZE : the new character width. The character height C and spacing will be scaled by the same factor. C If XSIZE is negative or zero, the character size C will be set to the default size. C-- C (1-Feb-1983) C 16-Sep-1985 - add code for metafile output (TJP). C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IDENT REAL XSIZE C C Record the new size (GRCFAC). C CALL GRSLCT(IDENT) IF (XSIZE.LE.0.0) THEN GRCFAC(IDENT) = 1.0 ELSE GRCFAC(IDENT) = XSIZE / GRCXSZ END IF C END pgplot/src/grsetpen.f010064400040640000322000000004360546005550100153220ustar00tjpcitmbr00000400000017 C*GRSETPEN -- *obsolete routine* C+ SUBROUTINE GRSETPEN C C GRPCKG: Set the pen number for subsequent plotting. Obsolete C routine: ignored. C----------------------------------------------------------------------- CALL GRWARN('GRSETPEN is an obsolete routine.') END pgplot/src/grtran.f010064400040640000322000000014630546005550400147740ustar00tjpcitmbr00000400000017 C*GRTRAN -- define scaling transformation C+ SUBROUTINE GRTRAN (IDENT,XORG,YORG,XSCALE,YSCALE) C C GRPCKG (internal routine): Define scaling transformation. C C Arguments: C C IDENT (input, integer): plot identifier, as returned by GROPEN. C XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling C transformation. This is defined by: C XABS = XORG + XWORLD * XSCALE, C YABS = YORG + YWORLD * YSCALE, C where (XABS, YABS) are the absolute device coordinates C corresponding to world coordinates (XWORLD, YWORLD). C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER IDENT REAL XORG, YORG, XSCALE, YSCALE C CALL GRSLCT(IDENT) CALL GRTRN0(XORG, YORG, XSCALE, YSCALE) C END pgplot/src/grvect.f010064400040640000322000000027300546005550500147700ustar00tjpcitmbr00000400000017 C*GRVECT -- draw line segments or dots C+ SUBROUTINE GRVECT (IDENT,MODE,ABSXY,POINTS,X,Y) C C GRPCKG: Draw a line or a set of dots. This routine can be used to C draw a single line-segment, a continuous series of line segments, or C one or more single dots (pixels). C C Arguments: C C IDENT (input, integer): the plot identifier, as returned by GROPEN. C MODE (input, integer): if MODE=1, a series of line segments is drawn, C starting at the current position, moving to X(1),Y(1), ... and C ending at X(POINTS),Y(POINTS). C If MODE=2, the first vector is blanked, so the line starts at C X(1),Y(1). C If MODE=3, a single dot is placed at each coordinate pair, with C no connecting lines. C ABSXY (input, logical): if TRUE, the coordinates are absolute device C coordinates; if FALSE, they are world coordinates and the C scaling transformation is applied. C POINTS (input, integer): the number of coordinate pairs. C X, Y (input, real arrays, dimensioned POINTS or greater): the C X and Y coordinates of the points. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INTEGER IDENT, MODE, POINTS LOGICAL ABSXY REAL X(POINTS), Y(POINTS) C CALL GRSLCT(IDENT) IF (MODE.LE.0 .OR. MODE.GT.3) THEN CALL GRWARN('GRVECT - invalid MODE parameter.') ELSE IF (POINTS.GT.0) THEN CALL GRVCT0(MODE, ABSXY, POINTS, X, Y) END IF C END pgplot/src/grsets.f010064400040640000322000000033220563567467000150210ustar00tjpcitmbr00000400000017C*GRSETS -- change size of view surface C+ SUBROUTINE GRSETS (IDENT,XSIZE,YSIZE) C C GRPCKG : change size of plotting area. The requested dimensions C will be reduced to the absolute maximum of the plot device if C necessary. C C Arguments: C C IDENT (input, integer): plot identifier from GROPEN. C XSIZE (input, real): new x dimension of plot area (absolute C units); if less than zero, the default dimension C will be used. C YSIZE (input, real): new y dimension of plot area (absolute C units); if less than zero, the default dimension C will be used. C-- C (1-Feb-1983) C 5-Aug-1986 - add GREXEC support [AFT]. C 5-Jan-1993 - set GRADJU [TJP]. C------------------------------------------------------------------------ INCLUDE 'grpckg1.inc' INTEGER I, IDENT, J, IX, IY, NBUF,LCHR REAL RBUF(6) CHARACTER CHR REAL XSIZE,YSIZE C CALL GRSLCT(IDENT) C write (*,*) 'GRSETS: old size', GRXMXA(IDENT), GRYMXA(IDENT) CALL GRPAGE IF ((XSIZE .LT. 0.0) .OR. (YSIZE .LT. 0.0)) THEN CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR) GRXMXA(IDENT) = RBUF(2) GRYMXA(IDENT) = RBUF(4) ELSE I = NINT(XSIZE) J = NINT(YSIZE) CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR) IX=RBUF(2) IY=RBUF(4) IF (IX.GT.0) I = MIN(I,IX) IF (IY.GT.0) J = MIN(J,IY) GRXMXA(IDENT) = I GRYMXA(IDENT) = J END IF C write (*,*) 'GRSETS: new size', GRXMXA(IDENT), GRYMXA(IDENT) GRXMIN(IDENT) = 0 GRXMAX(IDENT) = GRXMXA(IDENT) GRYMIN(IDENT) = 0 GRYMAX(IDENT) = GRYMXA(IDENT) GRADJU(IDENT) = .TRUE. C END pgplot/src/grsfnt.f010064400040640000322000000020460546005550100147750ustar00tjpcitmbr00000400000017C*GRSFNT -- set text font C+ SUBROUTINE GRSFNT (IF) INTEGER IF C C GRPCKG: Set the font for subsequent text plotting. C The default font is 1 ("Normal" font); others available are 2 C ("Roman"), 3 ("Italic"), and 4 ("Script"). C C Argument: C IF (input): the font number to be used for subsequent C text plotting on the current device (in range 1-4). C-- C 19-Mar-1983 - [TJP]. C 4-Jun-1984 - add code for GMFILE device [TJP]. C 15-Dec-1988 - change name [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSFNT - no graphics device is active.') RETURN END IF C C Set software font index. C IF (IF.LT.1 .OR. IF.GT.4) THEN CALL GRWARN('Illegal font selected: font 1 used.') I = 1 ELSE I = IF END IF C C Ignore request if no change is to be made. C IF (IF.EQ.GRCFNT(GRCIDE)) RETURN C C Save font setting. C GRCFNT(GRCIDE) = I C END pgplot/src/grsize.f010064400040640000322000000014470546005550200150020ustar00tjpcitmbr00000400000017 C*GRSIZE -- inquire device size and resolution C+ SUBROUTINE GRSIZE (IDENT,XSZDEF,YSZDEF,XSZMAX,YSZMAX, 1 XPERIN,YPERIN) C C GRPCKG : obtain device parameters (user-callable routine). C-- C (1-Feb-1983) C 5-Aug-1986 - add GREXEC support [AFT]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IDENT REAL XSZDEF, YSZDEF, XSZMAX, YSZMAX, XPERIN, YPERIN INTEGER NBUF,LCHR REAL RBUF(6) CHARACTER CHR C CALL GRSLCT(IDENT) CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR) XSZDEF = RBUF(2) YSZDEF = RBUF(4) CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR) XSZMAX = RBUF(2) YSZMAX = RBUF(4) XPERIN = GRPXPI(GRCIDE) YPERIN = GRPYPI(GRCIDE) C END pgplot/src/grskpb.f010064400040640000322000000016160546005550200147650ustar00tjpcitmbr00000400000017C*GRSKPB -- skip blanks in character string C+ SUBROUTINE GRSKPB (S, I) CHARACTER*(*) S INTEGER I C C GRSKPB: increment I so that it points to the next non-blank C character in string S. 'Blank' characters are space and tab (ASCII C character value 9). C C Arguments: C S (input) : character string to be parsed. C I (in/out) : on input, I is the index of the first character C in S to be examined; on output, either it points C to the next non-blank character, or it is equal C to LEN(S)+1 (if all the rest of the string is C blank). C-- C 1985 Oct 8 - New routine, based on SKIPBL (T. J. Pearson). C----------------------------------------------------------------------- C 10 IF (I.GT.LEN(S)) RETURN IF (S(I:I).NE.' ' .AND. S(I:I).NE.CHAR(9)) RETURN I = I+1 GOTO 10 END pgplot/src/grslct.f010064400040640000322000000022470674243570600150100ustar00tjpcitmbr00000400000017C*GRSLCT -- select active output device C+ SUBROUTINE GRSLCT (IDENT) C C GRPCKG: Check that IDENT is a valid plot identifier, and select the C corresponding plot as the current plot. All subsequent plotting will C be directed to this device until the assignment is changed by another C call to GRSLCT. C C Argument: C C IDENT (input, integer): the identifier of the plot to be selected, as C returned by GROPEN. C-- C (1-Feb-1983) C 5-Aug-1986 - add GREXEC support [AFT]. C 4-Jun-1987 - skip action if no change in ID [TJP]. C 26-Nov-1990 - [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER IDENT, NBUF,LCHR CHARACTER CHR C IF ((IDENT.LE.0) .OR. (IDENT.GT.GRIMAX) .OR. 1 (GRSTAT(IDENT).EQ.0)) THEN CALL GRWARN('GRSLCT - invalid plot identifier.') ELSE IF (IDENT.EQ.GRCIDE) THEN GRGTYP = GRTYPE(IDENT) RETURN ELSE GRCIDE = IDENT GRGTYP = GRTYPE(IDENT) RBUF(1)= GRCIDE RBUF(2)= GRUNIT(GRCIDE) NBUF = 2 CALL GREXEC(GRGTYP, 8,RBUF,NBUF,CHR,LCHR) END IF END pgplot/src/grslw.f010064400040640000322000000044520563141547200146420ustar00tjpcitmbr00000400000017C*GRSLW -- set line width C+ SUBROUTINE GRSLW (IW) INTEGER IW C C GRPCKG: Set the line width for subsequent plotting on the current C device. If the hardware does not support thick lines, they are C simulated by tracing each line with multiple strokes offset in the C direction perpendicular to the line. The line width is specified by C the number of strokes to be used, which must be in the range 1-201. C The actual line width obtained depends on the device resolution. C If the hardware does support thick lines, the width of the line C is approximately 0.005 inches times the value of argument IW. C C Argument: C C IW (integer, input): the number of strokes to be used for subsequent C plotting on the current device (in range 1-201). C-- C 1-Feb-1983 [TJP]. C 3-Jun-1984 [TJP] - add GMFILE device. C 28-Aug-1984 [TJP] - correct bug in GMFILE: redundant SET_LINEWIDTH C commands were not being filtered out. C 26-May-1987 [TJP] - add GREXEC support. C 11-Jun-1987 [TJP] - remove built-in devices. C 31-May-1989 [TJP] - increase maximum width from 21 to 201. C 1-Sep-1994 [TJP] C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I, ITHICK REAL RBUF(1) INTEGER NBUF,LCHR CHARACTER*32 CHR C C Check that graphics is active. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSLW - no graphics device is active.') RETURN END IF C C Check that requested line-width is valid. C I = IW IF (I.LT.1 .OR. I.GT.201) THEN CALL GRWARN('GRSLW - invalid line-width requested.') I = 1 END IF C C Ignore the request if the linewidth is unchanged. C IF (I.EQ.ABS(GRWIDT(GRCIDE))) RETURN C C Inquire if hardware supports thick lines. C ITHICK = 0 IF (GRGCAP(GRCIDE)(5:5).EQ.'T') ITHICK = 1 C C For devices with hardware support of thick lines, send the C appropriate commands to the device driver, and give the "current C linewidth" parameter a negative value to suppress software linewidth C emulation. C IF (ITHICK.EQ.1 .AND. GRPLTD(GRCIDE)) THEN RBUF(1) = I CALL GREXEC(GRGTYP,22,RBUF,NBUF,CHR,LCHR) END IF C C Save the current linewidth. C GRWIDT(GRCIDE) = I IF (ITHICK.EQ.1) GRWIDT(GRCIDE) = -I C END pgplot/src/grsymk.f010064400040640000322000000462260600604336400150170ustar00tjpcitmbr00000400000017C*GRSYMK -- convert character number into symbol number C+ SUBROUTINE GRSYMK (CODE, FONT, SYMBOL) INTEGER CODE, FONT, SYMBOL C C This routine returns the Hershey symbol number (SYMBOL) corresponding C to ASCII code CODE in font FONT. C C Characters 0-31 are the same in all fonts, and are the standard C graph markers. Characters 32-127 are standard representations of C the ASCII codes. Characters 128-255 are reserved for the upper C half of the ISO Latin-1 character set. Characters 256-303 are C used for the greek alphabet. C C Arguments: C CODE (input) : the extended ASCII code number. C FONT (input) : the font to be used 31 (range 1-4). C SYMBOL (output) : the number of the symbol to be plotted. C-- C 24-Apr-1986. C 15-Dec-1988 - standardize [TJP]. C 29-Nov-1990 - eliminate common block [TJP]. C 27-Nov-1991 - correct code for backslash [TJP]. C 27-Jul-1995 - extend for 256-character set; add some defaults for C ISO Latin-1 (full glyph set not available) [TJP]. C----------------------------------------------------------------------- INTEGER I, K, HERSH(0:303,4) SAVE HERSH C C Special characters (graph markers). C DATA (HERSH( 0,K),K=1,4) / 841, 841, 841, 841/ DATA (HERSH( 1,K),K=1,4) / 899, 899, 899, 899/ DATA (HERSH( 2,K),K=1,4) / 845, 845, 845, 845/ DATA (HERSH( 3,K),K=1,4) / 847, 847, 847, 847/ DATA (HERSH( 4,K),K=1,4) / 840, 840, 840, 840/ DATA (HERSH( 5,K),K=1,4) / 846, 846, 846, 846/ DATA (HERSH( 6,K),K=1,4) / 841, 841, 841, 841/ DATA (HERSH( 7,K),K=1,4) / 842, 842, 842, 842/ DATA (HERSH( 8,K),K=1,4) /2284,2284,2284,2284/ DATA (HERSH( 9,K),K=1,4) /2281,2281,2281,2281/ DATA (HERSH( 10,K),K=1,4) / 735, 735, 735, 735/ DATA (HERSH( 11,K),K=1,4) / 843, 843, 843, 843/ DATA (HERSH( 12,K),K=1,4) / 844, 844, 844, 844/ DATA (HERSH( 13,K),K=1,4) / 852, 852, 852, 852/ DATA (HERSH( 14,K),K=1,4) / 866, 866, 866, 866/ DATA (HERSH( 15,K),K=1,4) / 868, 868, 868, 868/ DATA (HERSH( 16,K),K=1,4) / 851, 851, 851, 851/ DATA (HERSH( 17,K),K=1,4) / 850, 850, 850, 850/ DATA (HERSH( 18,K),K=1,4) / 856, 856, 856, 856/ DATA (HERSH( 19,K),K=1,4) / 254, 254, 254, 254/ DATA (HERSH( 20,K),K=1,4) / 900, 900, 900, 900/ DATA (HERSH( 21,K),K=1,4) / 901, 901, 901, 901/ DATA (HERSH( 22,K),K=1,4) / 902, 902, 902, 902/ DATA (HERSH( 23,K),K=1,4) / 903, 903, 903, 903/ DATA (HERSH( 24,K),K=1,4) / 904, 904, 904, 904/ DATA (HERSH( 25,K),K=1,4) / 905, 905, 905, 905/ DATA (HERSH( 26,K),K=1,4) / 906, 906, 906, 906/ DATA (HERSH( 27,K),K=1,4) / 907, 907, 907, 907/ DATA (HERSH( 28,K),K=1,4) /2263,2263,2263,2263/ DATA (HERSH( 29,K),K=1,4) /2261,2261,2261,2261/ DATA (HERSH( 30,K),K=1,4) /2262,2262,2262,2262/ DATA (HERSH( 31,K),K=1,4) /2264,2264,2264,2264/ C C US-ASCII (ISO Latin-1 lower half). C C 32:39 space exclam quotdbl numbersign C dollar percent ampersand quoteright DATA (HERSH( 32,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH( 33,K),K=1,4) / 714,2214,2764,2764/ DATA (HERSH( 34,K),K=1,4) / 717,2217,2778,2778/ DATA (HERSH( 35,K),K=1,4) / 733,2275,2275,2275/ DATA (HERSH( 36,K),K=1,4) / 719,2274,2769,2769/ DATA (HERSH( 37,K),K=1,4) /2271,2271,2271,2271/ DATA (HERSH( 38,K),K=1,4) / 734,2272,2768,2768/ DATA (HERSH( 39,K),K=1,4) / 716,2216,2777,2777/ C 40:47 parenleft parenright asterisk plus C comma minus period slash DATA (HERSH( 40,K),K=1,4) / 721,2221,2771,2771/ DATA (HERSH( 41,K),K=1,4) / 722,2222,2772,2772/ DATA (HERSH( 42,K),K=1,4) / 728,2219,2773,2773/ DATA (HERSH( 43,K),K=1,4) / 725,2232,2775,2775/ DATA (HERSH( 44,K),K=1,4) / 711,2211,2761,2761/ DATA (HERSH( 45,K),K=1,4) / 724,2231,2774,2774/ DATA (HERSH( 46,K),K=1,4) / 710,2210,2760,2760/ DATA (HERSH( 47,K),K=1,4) / 720,2220,2770,2770/ C 48:55 zero one two three four five six seven DATA (HERSH( 48,K),K=1,4) / 700,2200,2750,2750/ DATA (HERSH( 49,K),K=1,4) / 701,2201,2751,2751/ DATA (HERSH( 50,K),K=1,4) / 702,2202,2752,2752/ DATA (HERSH( 51,K),K=1,4) / 703,2203,2753,2753/ DATA (HERSH( 52,K),K=1,4) / 704,2204,2754,2754/ DATA (HERSH( 53,K),K=1,4) / 705,2205,2755,2755/ DATA (HERSH( 54,K),K=1,4) / 706,2206,2756,2756/ DATA (HERSH( 55,K),K=1,4) / 707,2207,2757,2757/ C 56:63 eight nine colon semicolon less equal greater question DATA (HERSH( 56,K),K=1,4) / 708,2208,2758,2758/ DATA (HERSH( 57,K),K=1,4) / 709,2209,2759,2759/ DATA (HERSH( 58,K),K=1,4) / 712,2212,2762,2762/ DATA (HERSH( 59,K),K=1,4) / 713,2213,2763,2763/ DATA (HERSH( 60,K),K=1,4) /2241,2241,2241,2241/ DATA (HERSH( 61,K),K=1,4) / 726,2238,2776,2776/ DATA (HERSH( 62,K),K=1,4) /2242,2242,2242,2242/ DATA (HERSH( 63,K),K=1,4) / 715,2215,2765,2765/ C 64:71 at A B C D E F G DATA (HERSH( 64,K),K=1,4) /2273,2273,2273,2273/ DATA (HERSH( 65,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH( 66,K),K=1,4) / 502,2002,2052,2552/ DATA (HERSH( 67,K),K=1,4) / 503,2003,2053,2553/ DATA (HERSH( 68,K),K=1,4) / 504,2004,2054,2554/ DATA (HERSH( 69,K),K=1,4) / 505,2005,2055,2555/ DATA (HERSH( 70,K),K=1,4) / 506,2006,2056,2556/ DATA (HERSH( 71,K),K=1,4) / 507,2007,2057,2557/ C 72:79 H I J K L M N O DATA (HERSH( 72,K),K=1,4) / 508,2008,2058,2558/ DATA (HERSH( 73,K),K=1,4) / 509,2009,2059,2559/ DATA (HERSH( 74,K),K=1,4) / 510,2010,2060,2560/ DATA (HERSH( 75,K),K=1,4) / 511,2011,2061,2561/ DATA (HERSH( 76,K),K=1,4) / 512,2012,2062,2562/ DATA (HERSH( 77,K),K=1,4) / 513,2013,2063,2563/ DATA (HERSH( 78,K),K=1,4) / 514,2014,2064,2564/ DATA (HERSH( 79,K),K=1,4) / 515,2015,2065,2565/ C 80:87 P Q R S T U V W DATA (HERSH( 80,K),K=1,4) / 516,2016,2066,2566/ DATA (HERSH( 81,K),K=1,4) / 517,2017,2067,2567/ DATA (HERSH( 82,K),K=1,4) / 518,2018,2068,2568/ DATA (HERSH( 83,K),K=1,4) / 519,2019,2069,2569/ DATA (HERSH( 84,K),K=1,4) / 520,2020,2070,2570/ DATA (HERSH( 85,K),K=1,4) / 521,2021,2071,2571/ DATA (HERSH( 86,K),K=1,4) / 522,2022,2072,2572/ DATA (HERSH( 87,K),K=1,4) / 523,2023,2073,2573/ C 88:95 X Y Z bracketleft C backslash bracketright asciicircum underscore DATA (HERSH( 88,K),K=1,4) / 524,2024,2074,2574/ DATA (HERSH( 89,K),K=1,4) / 525,2025,2075,2575/ DATA (HERSH( 90,K),K=1,4) / 526,2026,2076,2576/ DATA (HERSH( 91,K),K=1,4) /2223,2223,2223,2223/ DATA (HERSH( 92,K),K=1,4) / 804, 804, 804, 804/ DATA (HERSH( 93,K),K=1,4) /2224,2224,2224,2224/ DATA (HERSH( 94,K),K=1,4) / 718,2218,2779,2779/ DATA (HERSH( 95,K),K=1,4) / 590, 590, 590, 590/ C 96:103 quoteleft a b c d e f g DATA (HERSH( 96,K),K=1,4) /2249,2249,2249,2249/ DATA (HERSH( 97,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH( 98,K),K=1,4) / 602,2102,2152,2652/ DATA (HERSH( 99,K),K=1,4) / 603,2103,2153,2653/ DATA (HERSH(100,K),K=1,4) / 604,2104,2154,2654/ DATA (HERSH(101,K),K=1,4) / 605,2105,2155,2655/ DATA (HERSH(102,K),K=1,4) / 606,2106,2156,2656/ DATA (HERSH(103,K),K=1,4) / 607,2107,2157,2657/ C 104:111 h i j k l m n o DATA (HERSH(104,K),K=1,4) / 608,2108,2158,2658/ DATA (HERSH(105,K),K=1,4) / 609,2109,2159,2659/ DATA (HERSH(106,K),K=1,4) / 610,2110,2160,2660/ DATA (HERSH(107,K),K=1,4) / 611,2111,2161,2661/ DATA (HERSH(108,K),K=1,4) / 612,2112,2162,2662/ DATA (HERSH(109,K),K=1,4) / 613,2113,2163,2663/ DATA (HERSH(110,K),K=1,4) / 614,2114,2164,2664/ DATA (HERSH(111,K),K=1,4) / 615,2115,2165,2665/ C 112:119 p q r s t u v w DATA (HERSH(112,K),K=1,4) / 616,2116,2166,2666/ DATA (HERSH(113,K),K=1,4) / 617,2117,2167,2667/ DATA (HERSH(114,K),K=1,4) / 618,2118,2168,2668/ DATA (HERSH(115,K),K=1,4) / 619,2119,2169,2669/ DATA (HERSH(116,K),K=1,4) / 620,2120,2170,2670/ DATA (HERSH(117,K),K=1,4) / 621,2121,2171,2671/ DATA (HERSH(118,K),K=1,4) / 622,2122,2172,2672/ DATA (HERSH(119,K),K=1,4) / 623,2123,2173,2673/ C 120:127 x y z braceleft bar braceright asciitilde - DATA (HERSH(120,K),K=1,4) / 624,2124,2174,2674/ DATA (HERSH(121,K),K=1,4) / 625,2125,2175,2675/ DATA (HERSH(122,K),K=1,4) / 626,2126,2176,2676/ DATA (HERSH(123,K),K=1,4) /2225,2225,2225,2225/ DATA (HERSH(124,K),K=1,4) / 723,2229,2229,2229/ DATA (HERSH(125,K),K=1,4) /2226,2226,2226,2226/ DATA (HERSH(126,K),K=1,4) /2246,2246,2246,2246/ DATA (HERSH(127,K),K=1,4) / 699,2199,2199,2199/ C C ISO Latin-1 upper half. C C 128:135 - - - - - - - - DATA (HERSH(128,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(129,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(130,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(131,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(132,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(133,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(134,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(135,K),K=1,4) / 699,2199,2199,2199/ C 136:143 - - - - - - - - DATA (HERSH(136,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(137,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(138,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(139,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(140,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(141,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(142,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(143,K),K=1,4) / 699,2199,2199,2199/ C 144:151 dotlessi grave acute circumflex tilde - breve dotaccent DATA (HERSH(144,K),K=1,4) / 699,2182,2196,2199/ DATA (HERSH(145,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(146,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(147,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(148,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(149,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(150,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(151,K),K=1,4) / 699,2199,2199,2199/ C 152:159 dieresis - ring - - - - - DATA (HERSH(152,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(153,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(154,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(155,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(156,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(157,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(158,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(159,K),K=1,4) / 699,2199,2199,2199/ C 160:167 space exclamdown cent sterling currency yen brokenbar section DATA (HERSH(160,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(161,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(162,K),K=1,4) / 910, 910, 910, 910/ DATA (HERSH(163,K),K=1,4) / 272, 272, 272, 272/ DATA (HERSH(164,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(165,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(166,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(167,K),K=1,4) /2276,2276,2276,2276/ C 168:175 - copyright - - - - registered - DATA (HERSH(168,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(169,K),K=1,4) / 274, 274, 274, 274/ DATA (HERSH(170,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(171,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(172,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(173,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(174,K),K=1,4) / 273, 273, 273, 273/ DATA (HERSH(175,K),K=1,4) / 699,2199,2199,2199/ C 176:183 degree plusminus twosuperior threesuperior C acute mu paragraph periodcentered DATA (HERSH(176,K),K=1,4) / 718,2218,2779,2779/ DATA (HERSH(177,K),K=1,4) /2233,2233,2233,2233/ DATA (HERSH(178,K),K=1,4) / 702,2202,2752,2752/ DATA (HERSH(179,K),K=1,4) / 703,2203,2753,2753/ DATA (HERSH(180,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(181,K),K=1,4) / 638,2138,2138,2138/ DATA (HERSH(182,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(183,K),K=1,4) / 729, 729, 729, 729/ C 184:191 cedilla onesuperior ordmasculine guillemotright C onequarter onehalf threequarters questiondown DATA (HERSH(184,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(185,K),K=1,4) / 701,2201,2751,2751/ DATA (HERSH(186,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(187,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(188,K),K=1,4) / 270, 270, 270, 270/ DATA (HERSH(189,K),K=1,4) / 261, 261, 261, 261/ DATA (HERSH(190,K),K=1,4) / 271, 271, 271, 271/ DATA (HERSH(191,K),K=1,4) / 699,2199,2199,2199/ C 192:199 Agrave Aacute Acircumflex Atilde Aring AE Ccedilla DATA (HERSH(192,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH(193,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH(194,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH(195,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH(196,K),K=1,4) / 501,2001,2051,2551/ DATA (HERSH(197,K),K=1,4) / 501,2078,2051,2551/ DATA (HERSH(198,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(199,K),K=1,4) / 503,2003,2053,2553/ C 200:207 Egrave Eacute Ecircumflex Edieresis C Igrave Iacute Icircumflex Idieresis DATA (HERSH(200,K),K=1,4) / 505,2005,2055,2555/ DATA (HERSH(201,K),K=1,4) / 505,2005,2055,2555/ DATA (HERSH(202,K),K=1,4) / 505,2005,2055,2555/ DATA (HERSH(203,K),K=1,4) / 505,2005,2055,2555/ DATA (HERSH(204,K),K=1,4) / 509,2009,2059,2559/ DATA (HERSH(205,K),K=1,4) / 509,2009,2059,2559/ DATA (HERSH(206,K),K=1,4) / 509,2009,2059,2559/ DATA (HERSH(207,K),K=1,4) / 509,2009,2059,2559/ C 208:215 Eth Ntilde Ograve Oacute C Ocircumflex Otilde Odieresis multiply DATA (HERSH(208,K),K=1,4) / 504,2004,2054,2554/ DATA (HERSH(209,K),K=1,4) / 514,2014,2064,2564/ DATA (HERSH(210,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(211,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(212,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(213,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(214,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(215,K),K=1,4) /2235,2235,2235,2235/ C 216:223 Oslash Ugrave Uacute Ucircumflex C Udieresis Yacute Thorn germandbls DATA (HERSH(216,K),K=1,4) / 515,2015,2065,2565/ DATA (HERSH(217,K),K=1,4) / 521,2021,2071,2571/ DATA (HERSH(218,K),K=1,4) / 521,2021,2071,2571/ DATA (HERSH(219,K),K=1,4) / 521,2021,2071,2571/ DATA (HERSH(220,K),K=1,4) / 521,2021,2071,2571/ DATA (HERSH(221,K),K=1,4) / 525,2025,2075,2575/ DATA (HERSH(222,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(223,K),K=1,4) / 699,2199,2199,2199/ C 224:231 agrave aacute acircumflex atilde aring ae ccedilla DATA (HERSH(224,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(225,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(226,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(227,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(228,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(229,K),K=1,4) / 601,2101,2151,2651/ DATA (HERSH(230,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(231,K),K=1,4) / 603,2103,2153,2653/ C 232:239 egrave eacute ecircumflex edieresis C igrave iacute icircumflex idieresis DATA (HERSH(232,K),K=1,4) / 605,2105,2155,2655/ DATA (HERSH(233,K),K=1,4) / 605,2105,2155,2655/ DATA (HERSH(234,K),K=1,4) / 605,2105,2155,2655/ DATA (HERSH(235,K),K=1,4) / 605,2105,2155,2655/ DATA (HERSH(236,K),K=1,4) / 609,2109,2159,2659/ DATA (HERSH(237,K),K=1,4) / 609,2109,2159,2659/ DATA (HERSH(238,K),K=1,4) / 609,2109,2159,2659/ DATA (HERSH(239,K),K=1,4) / 609,2109,2159,2659/ C 240:247 eth ntilde ograve oacute C ocircumflex otilde odieresis divide DATA (HERSH(240,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(241,K),K=1,4) / 614,2114,2164,2664/ DATA (HERSH(242,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(243,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(244,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(245,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(246,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(247,K),K=1,4) /2237,2237,2237,2237/ C 248:255 oslash ugrave uacute ucircumflex C udieresis yacute thorn ydieresis DATA (HERSH(248,K),K=1,4) / 615,2115,2165,2665/ DATA (HERSH(249,K),K=1,4) / 621,2121,2171,2671/ DATA (HERSH(250,K),K=1,4) / 621,2121,2171,2671/ DATA (HERSH(251,K),K=1,4) / 621,2121,2171,2671/ DATA (HERSH(252,K),K=1,4) / 621,2121,2171,2671/ DATA (HERSH(253,K),K=1,4) / 625,2125,2175,2675/ DATA (HERSH(254,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(255,K),K=1,4) / 625,2125,2175,2675/ C C Greek alphabet. C DATA (HERSH(256,K),K=1,4) / 527,2027,2027,2027/ DATA (HERSH(257,K),K=1,4) / 528,2028,2028,2028/ DATA (HERSH(258,K),K=1,4) / 529,2029,2029,2029/ DATA (HERSH(259,K),K=1,4) / 530,2030,2030,2030/ DATA (HERSH(260,K),K=1,4) / 531,2031,2031,2031/ DATA (HERSH(261,K),K=1,4) / 532,2032,2032,2032/ DATA (HERSH(262,K),K=1,4) / 533,2033,2033,2033/ DATA (HERSH(263,K),K=1,4) / 534,2034,2034,2034/ DATA (HERSH(264,K),K=1,4) / 535,2035,2035,2035/ DATA (HERSH(265,K),K=1,4) / 536,2036,2036,2036/ DATA (HERSH(266,K),K=1,4) / 537,2037,2037,2037/ DATA (HERSH(267,K),K=1,4) / 538,2038,2038,2038/ DATA (HERSH(268,K),K=1,4) / 539,2039,2039,2039/ DATA (HERSH(269,K),K=1,4) / 540,2040,2040,2040/ DATA (HERSH(270,K),K=1,4) / 541,2041,2041,2041/ DATA (HERSH(271,K),K=1,4) / 542,2042,2042,2042/ DATA (HERSH(272,K),K=1,4) / 543,2043,2043,2043/ DATA (HERSH(273,K),K=1,4) / 544,2044,2044,2044/ DATA (HERSH(274,K),K=1,4) / 545,2045,2045,2045/ DATA (HERSH(275,K),K=1,4) / 546,2046,2046,2046/ DATA (HERSH(276,K),K=1,4) / 547,2047,2047,2047/ DATA (HERSH(277,K),K=1,4) / 548,2048,2048,2048/ DATA (HERSH(278,K),K=1,4) / 549,2049,2049,2049/ DATA (HERSH(279,K),K=1,4) / 550,2050,2050,2050/ DATA (HERSH(280,K),K=1,4) / 627,2127,2127,2127/ DATA (HERSH(281,K),K=1,4) / 628,2128,2128,2128/ DATA (HERSH(282,K),K=1,4) / 629,2129,2129,2129/ DATA (HERSH(283,K),K=1,4) / 630,2130,2130,2130/ DATA (HERSH(284,K),K=1,4) / 684,2184,2184,2184/ DATA (HERSH(285,K),K=1,4) / 632,2132,2132,2132/ DATA (HERSH(286,K),K=1,4) / 633,2133,2133,2133/ DATA (HERSH(287,K),K=1,4) / 685,2185,2185,2185/ DATA (HERSH(288,K),K=1,4) / 635,2135,2135,2135/ DATA (HERSH(289,K),K=1,4) / 636,2136,2136,2136/ DATA (HERSH(290,K),K=1,4) / 637,2137,2137,2137/ DATA (HERSH(291,K),K=1,4) / 638,2138,2138,2138/ DATA (HERSH(292,K),K=1,4) / 639,2139,2139,2139/ DATA (HERSH(293,K),K=1,4) / 640,2140,2140,2140/ DATA (HERSH(294,K),K=1,4) / 641,2141,2141,2141/ DATA (HERSH(295,K),K=1,4) / 642,2142,2142,2142/ DATA (HERSH(296,K),K=1,4) / 643,2143,2143,2143/ DATA (HERSH(297,K),K=1,4) / 644,2144,2144,2144/ DATA (HERSH(298,K),K=1,4) / 645,2145,2145,2145/ DATA (HERSH(299,K),K=1,4) / 646,2146,2146,2146/ DATA (HERSH(300,K),K=1,4) / 686,2186,2186,2186/ DATA (HERSH(301,K),K=1,4) / 648,2148,2148,2148/ DATA (HERSH(302,K),K=1,4) / 649,2149,2149,2149/ DATA (HERSH(303,K),K=1,4) / 650,2150,2150,2150/ C IF ((CODE.LT.0) .OR. (CODE.GT.303)) THEN I = 1 ELSE I = CODE END IF SYMBOL = HERSH(I,FONT) C END RSH(138,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(139,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(140,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(141,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(142,K),K=1,4) / 699,2199,2199,2199/ DATA (HERSH(143,K),K=1,4) / 699,2199,2199,2199/ C 144:151 dotlessi grave acute circumflex tilde - pgplot/src/grterm.f010064400040640000322000000015660674243460600150130ustar00tjpcitmbr00000400000017 C*GRTERM -- flush buffer to output device C+ SUBROUTINE GRTERM C C GRPCKG: flush the buffer associated with the current plot. GRTERM C should be called only when it is necessary to make sure that all the C graphics created up to this point in the program are visible on the C device, e.g., before beginning a dialog with the user. GRTERM has no C effect on hardcopy devices. C C Arguments: none. C-- C 6-Oct-1983 C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 31-Dec-1985 - do not send CAN code to true Tek [TJP/PCP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 11-Jun-1987 - remove built-in devices [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF,LCHR REAL RBUF(6) CHARACTER CHR C IF (GRCIDE.GE.1) THEN CALL GREXEC(GRGTYP,16,RBUF,NBUF,CHR,LCHR) END IF END pgplot/src/grtoup.f010064400040640000322000000014240546005550400150140ustar00tjpcitmbr00000400000017 C*GRTOUP -- convert character string to upper case C+ SUBROUTINE GRTOUP (DST, SRC) CHARACTER*(*) DST, SRC C C GRPCKG (internal routine): convert character string to upper case. C C Arguments: C DST (output) : output string (upper case). C SRC (input) : input string to be converted. C-- C 1988-Jan-18 (TJP) C----------------------------------------------------------------------- INTEGER I, N, NCHI, NCHO, NCH NCHI = LEN(SRC) NCHO = LEN(DST) NCH = MIN(NCHI, NCHO) DO 10 I=1,NCH N = ICHAR(SRC(I:I)) IF ((N .GE. 97) .AND. (N .LE. 122)) THEN DST(I:I) = CHAR(N - 32) ELSE DST(I:I) = CHAR(N) END IF 10 CONTINUE IF (NCHO .GT. NCHI) DST(NCHI+1:NCHO) = ' ' END pgplot/src/pgsetc.f010064400040640000322000000001220555255507300147630ustar00tjpcitmbr00000400000017C SUBROUTINE PGSETC (SIZE) REAL SIZE CALL PGSCH(SIZE) END pgplot/src/grtrim.f010064400040640000322000000015750546005550400150070ustar00tjpcitmbr00000400000017C*GRTRIM -- length of string excluding trailing blanks C+ INTEGER FUNCTION GRTRIM(S) CHARACTER*(*) S C C Find the length of a character string excluding trailing blanks. C A blank string returns a value of 0. C C Argument: C S (input) : character string. C C Returns: C GRTRIM : number of characters in S, excluding trailing C blanks, in range 0...LEN(S). A blank string C returns a value of 0. C C Subroutines required: C None C C Fortran 77 extensions: C None C C History: C 1987 Nov 12 - TJP. C----------------------------------------------------------------------- INTEGER I C IF (S.EQ.' ') THEN GRTRIM = 0 ELSE DO 10 I=LEN(S),1,-1 GRTRIM = I IF (S(I:I).NE.' ') GOTO 20 10 CONTINUE GRTRIM = 0 20 CONTINUE END IF END pgplot/src/grtrn0.f010064400040640000322000000024430563141605600147150ustar00tjpcitmbr00000400000017 C*GRTRN0 -- define scaling transformation C+ SUBROUTINE GRTRN0 (XORG,YORG,XSCALE,YSCALE) C C GRPCKG (internal routine): Define scaling transformation for current C device (equivalent to GRTRAN without device selection). C C Arguments: C C XORG, YORG, XSCALE, YSCALE (input, real): parameters of the scaling C transformation. This is defined by: C XABS = XORG + XWORLD * XSCALE, C YABS = YORG + YWORLD * YSCALE, C where (XABS, YABS) are the absolute device coordinates C corresponding to world coordinates (XWORLD, YWORLD). C-- C 1-Feb-83: C 11-Feb-92: Add driver support (TJP). C 1-Sep-94: Suppress driver call (TJP). C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL XORG, YORG, XSCALE, YSCALE REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER*16 CHR C GRXORG(GRCIDE) = XORG GRXSCL(GRCIDE) = XSCALE GRYORG(GRCIDE) = YORG GRYSCL(GRCIDE) = YSCALE C C Pass info to device driver? C IF (GRGCAP(GRCIDE)(2:2).EQ.'X') THEN RBUF(1) = XORG RBUF(2) = XSCALE RBUF(3) = YORG RBUF(4) = YSCALE NBUF = 4 LCHR = 0 CALL GREXEC(GRGTYP,27,RBUF,NBUF,CHR,LCHR) END IF C END pgplot/src/grtxy0.f010064400040640000322000000015670546005550500147420ustar00tjpcitmbr00000400000017 C*GRTXY0 -- convert world coordinates to device coordinates C+ SUBROUTINE GRTXY0 (ABSXY,X,Y,XT,YT) C C GRPCKG (internal routine): Convert scaled position to absolute C position. C C Arguments: C C ABSXY (input, logical): if FALSE, convert world coordinates to C absolute device coordinates; if TRUE, return the input C coordinates unchanged. C X, Y (input, real): input coordinates (absolute or world, depending C on setting of ABSXY). C XT, YT (output, real): output absolute device coordinates. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL ABSXY REAL X, Y, XT, YT C IF (ABSXY) THEN XT = X YT = Y ELSE XT = X * GRXSCL(GRCIDE) + GRXORG(GRCIDE) YT = Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE) END IF C END pgplot/src/grvct0.f010064400040640000322000000035570546005550500147130ustar00tjpcitmbr00000400000017 C*GRVCT0 -- draw line segments or dots C+ SUBROUTINE GRVCT0 (MODE,ABSXY,POINTS,X,Y) C C GRPCKG (internal routine): Draw a line or a set of dots. This C is the same as GRVECT, but without device selection. It can be used to C draw a single line-segment, a continuous series of line segments, or C one or more single dots (pixels). C C Arguments: C C MODE (input, integer): if MODE=1, a series of line segments is drawn, C starting at the current position, moving to X(1),Y(1), ... and C ending at X(POINTS),Y(POINTS). C If MODE=2, the first vector is blanked, so the line starts at C X(1),Y(1). C If MODE=3, a single dot is placed at each coordinate pair, with C no connecting lines. C ABSXY (input, logical): if TRUE, the coordinates are absolute device C coordinates; if FALSE, they are world coordinates and the C scaling transformation is applied. C POINTS (input, integer): the number of coordinate pairs. C X, Y (input, real arrays, dimensioned POINTS or greater): the C X and Y coordinates of the points. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I, MODE, POINTS LOGICAL ABSXY REAL X(POINTS), Y(POINTS), XCUR, YCUR C IF (MODE.EQ.1) THEN CALL GRTXY0(ABSXY, X(1), Y(1), XCUR, YCUR) CALL GRLIN0(XCUR, YCUR) ELSE IF (MODE.EQ.2) THEN CALL GRTXY0(ABSXY, X(1), Y(1), GRXPRE(GRCIDE), GRYPRE(GRCIDE)) END IF IF (MODE.EQ.1 .OR. MODE.EQ.2) THEN DO 10 I=2,POINTS CALL GRTXY0(ABSXY, X(I), Y(I), XCUR, YCUR) CALL GRLIN0(XCUR, YCUR) 10 CONTINUE ELSE IF (MODE.EQ.3) THEN DO 20 I=1,POINTS CALL GRTXY0(ABSXY, X(I), Y(I), XCUR, YCUR) CALL GRDOT0(XCUR, YCUR) 20 CONTINUE END IF C END pgplot/src/pgsize.f010064400040640000322000000017230566745052200150070ustar00tjpcitmbr00000400000017C SUBROUTINE PGSIZE (WIDTH, HEIGHT, SHIFTX, SHIFTY, DUMMY) C C PGPLOT (obsolete routine; use PGVSIZ in preference): Change the C size and position of the viewport. C C Arguments: C C WIDTH (input, real) : width of viewport in inches. C HEIGHT (input, real) : height of viewport in inches. C SHIFTX (input, real) : horizontal offset of bottom left corner C from blc of page or panel, in inches. C SHIFTY (input, real) : vertical offset of bottom left corner C from blc of page or panel, in inches. C DUMMY (input, real) : reserved for future use (must be 0.0). C-- C 13-Dec-1990 Make errors non-fatal [TJP]. C----------------------------------------------------------------------- REAL WIDTH,HEIGHT,SHIFTX,SHIFTY,DUMMY C IF (WIDTH.LE.0.0 .OR. HEIGHT.LE.0.0 .OR. DUMMY.NE.0.0) THEN CALL GRWARN('PGSIZE ignored: invalid arguments') RETURN END IF C CALL PGVSIZ(SHIFTX, SHIFTX+WIDTH, SHIFTY, SHIFTY+HEIGHT) END pgplot/src/grxhls.f010064400040640000322000000035020564262273000150050ustar00tjpcitmbr00000400000017C*GRXHLS -- convert RGB color to HLS color C+ SUBROUTINE GRXHLS (R,G,B,H,L,S) C C GRPCKG: Convert a color specified in the RGB color model to one in C the HLS model. This is a support routine: no graphics I/O occurs. C The inverse transformation is accomplished with routine GRXRGB. C Reference: SIGGRAPH Status Report of the Graphic Standards Planning C Committee, Computer Graphics, Vol.13, No.3, Association for C Computing Machinery, New York, NY, 1979. C C Arguments: C C R,G,B (real, input): red, green, blue color coordinates, each in the C range 0.0 to 1.0. Input outside this range causes HLS = (0,1,0) C [white] to be returned. C H,L,S (real, output): hue (0 to 360), lightness (0 to 1.0), and C saturation (0 to 1.0). C-- C 2-Jul-1984 - new routine [TJP]. C 29-Sep-1994 - force H to be in rnage 0-360 [Remko Scharroo; TJP]. C----------------------------------------------------------------------- REAL R,G,B, H,L,S, MA, MI, RR, GG, BB, D C H = 0.0 L = 1.0 S = 0.0 MA = MAX(R,G,B) MI = MIN(R,G,B) IF (MA.GT.1.0 .OR. MI.LT.0.0) RETURN RR = (MA-R) GG = (MA-G) BB = (MA-B) C C Lightness C L = 0.5*(MA+MI) C C Achromatic case (R=G=B) C IF (MA.EQ.MI) THEN S = 0.0 H = 0.0 C C Chromatic case C ELSE C -- Saturation D = MA-MI IF (L.LE.0.5) THEN S = D/(MA+MI) ELSE S = D/(2.0-MA-MI) END IF C -- Hue IF (R.EQ.MA) THEN C -- yellow to magenta H = (2.0*D+BB-GG) ELSE IF (G.EQ.MA) THEN H = (4.0*D+RR-BB) ELSE C ! (B.EQ.MA) H = (6.0*D+GG-RR) END IF H = MOD(H*60.0/D,360.0) IF (H.LT.0.0) H = H+360.0 END IF C END pgplot/src/pgqclp.f010064400040640000322000000010770630513365400147700ustar00tjpcitmbr00000400000017C*PGQCLP -- inquire clipping status C%void cpgqclp(int *state); C+ SUBROUTINE PGQCLP(STATE) INTEGER STATE C C Query the current clipping status (set by routine PGSCLP). C C Argument: C STATE (output) : receives the clipping status (0 => disabled, C 1 => enabled). C-- C 25-Feb-1997 [TJP] - new routine. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGQCLP')) THEN STATE = 1 ELSE STATE = PGCLP(PGID) END IF END pgplot/src/grmsg.f010064400040640000322000000007110566021357700146210ustar00tjpcitmbr00000400000017C*GRMSG -- issue message to user C+ SUBROUTINE GRMSG (TEXT) CHARACTER*(*) TEXT C C Display a message on standard output. C C Argument: C TEXT (input): text of message to be printed (the string C may not be blank). C-- C 8-Nov-1994 [TJP]. C----------------------------------------------------------------------- INTEGER GRTRIM C IF (TEXT.NE.' ') THEN WRITE (*, '(1X,A)') TEXT(1:GRTRIM(TEXT)) END IF END pgplot/src/pgnumb.f010064400040640000322000000151140560235576500147770ustar00tjpcitmbr00000400000017C*PGNUMB -- convert a number into a plottable character string C%void cpgnumb(int mm, int pp, int form, char *string, \ C% int *string_length); C+ SUBROUTINE PGNUMB (MM, PP, FORM, STRING, NC) INTEGER MM, PP, FORM CHARACTER*(*) STRING INTEGER NC C C This routine converts a number into a decimal character C representation. To avoid problems of floating-point roundoff, the C number must be provided as an integer (MM) multiplied by a power of 10 C (10**PP). The output string retains only significant digits of MM, C and will be in either integer format (123), decimal format (0.0123), C or exponential format (1.23x10**5). Standard escape sequences \u, \d C raise the exponent and \x is used for the multiplication sign. C This routine is used by PGBOX to create numeric labels for a plot. C C Formatting rules: C (a) Decimal notation (FORM=1): C - Trailing zeros to the right of the decimal sign are C omitted C - The decimal sign is omitted if there are no digits C to the right of it C - When the decimal sign is placed before the first digit C of the number, a zero is placed before the decimal sign C - The decimal sign is a period (.) C - No spaces are placed between digits (ie digits are not C grouped in threes as they should be) C - A leading minus (-) is added if the number is negative C (b) Exponential notation (FORM=2): C - The exponent is adjusted to put just one (non-zero) C digit before the decimal sign C - The mantissa is formatted as in (a), unless its value is C 1 in which case it and the multiplication sign are omitted C - If the power of 10 is not zero and the mantissa is not C zero, an exponent of the form \x10\u[-]nnn is appended, C where \x is a multiplication sign (cross), \u is an escape C sequence to raise the exponent, and as many digits nnn C are used as needed C (c) Automatic choice (FORM=0): C Decimal notation is used if the absolute value of the C number is less than 10000 or greater than or equal to C 0.01. Otherwise exponential notation is used. C C Arguments: C MM (input) C PP (input) : the value to be formatted is MM*10**PP. C FORM (input) : controls how the number is formatted: C FORM = 0 -- use either decimal or exponential C FORM = 1 -- use decimal notation C FORM = 2 -- use exponential notation C STRING (output) : the formatted character string, left justified. C If the length of STRING is insufficient, a single C asterisk is returned, and NC=1. C NC (output) : the number of characters used in STRING: C the string to be printed is STRING(1:NC). C-- C 23-Nov-1983 C 9-Feb-1988 [TJP] - Use temporary variable to avoid illegal character C assignments; remove non-standard DO loops. C 15-Dec-1988 [TJP] - More corrections of the same sort. C 27-Nov-1991 [TJP] - Change code for multiplication sign. C 23-Jun-1994 [TJP] - Partial implementation of FORM=1 and 2. C----------------------------------------------------------------------- CHARACTER*1 BSLASH CHARACTER*2 TIMES, UP, DOWN CHARACTER*20 WORK, WEXP, TEMP INTEGER M, P, ND, I, J, K, NBP LOGICAL MINUS C C Define backslash (escape) character and escape sequences. C BSLASH = CHAR(92) TIMES = BSLASH//'x' UP = BSLASH//'u' DOWN = BSLASH//'d' C C Zero is always printed as "0". C IF (MM.EQ.0) THEN STRING = '0' NC = 1 RETURN END IF C C If negative, make a note of that fact. C MINUS = MM.LT.0 M = ABS(MM) P = PP C C Convert M to a left-justified digit string in WORK. As M is a C positive integer, it cannot use more than 10 digits (2147483647). C J = 10 10 IF (M.NE.0) THEN K = MOD(M,10) M = M/10 WORK(J:J) = CHAR(ICHAR('0')+K) J = J-1 GOTO 10 END IF TEMP = WORK(J+1:) WORK = TEMP ND = 10-J C C Remove right-hand zeros, and increment P for each one removed. C ND is the final number of significant digits in WORK, and P the C power of 10 to be applied. Number of digits before decimal point C is NBP. C 20 IF (WORK(ND:ND).EQ.'0') THEN ND = ND-1 P = P+1 GOTO 20 END IF NBP = ND+MIN(P,0) C C Integral numbers of 4 or less digits are formatted as such. C IF ((P.GE.0) .AND. ((FORM.EQ.0 .AND. P+ND.LE.4) .OR. : (FORM.EQ.1 .AND. P+ND.LE.10))) THEN DO 30 I=1,P ND = ND+1 WORK(ND:ND) = '0' 30 CONTINUE P = 0 C C If NBP is 4 or less, simply insert a decimal point in the right place. C ELSE IF (FORM.NE.2.AND.NBP.GE.1.AND.NBP.LE.4.AND.NBP.LT.ND) THEN TEMP = WORK(NBP+1:ND) WORK(NBP+2:ND+1) = TEMP WORK(NBP+1:NBP+1) = '.' ND = ND+1 P = 0 C C Otherwise insert a decimal point after the first digit, and adjust P. C ELSE P = P + ND - 1 IF (FORM.NE.2 .AND. P.EQ.-1) THEN TEMP = WORK WORK = '0'//TEMP ND = ND+1 P = 0 ELSE IF (FORM.NE.2 .AND. P.EQ.-2) THEN TEMP = WORK WORK = '00'//TEMP ND = ND+2 P = 0 END IF IF (ND.GT.1) THEN TEMP = WORK(2:ND) WORK(3:ND+1) = TEMP WORK(2:2) = '.' ND = ND + 1 END IF END IF C C Add exponent if necessary. C IF (P.NE.0) THEN WORK(ND+1:ND+6) = TIMES//'10'//UP ND = ND+6 IF (P.LT.0) THEN P = -P ND = ND+1 WORK(ND:ND) = '-' END IF J = 10 40 IF (P.NE.0) THEN K = MOD(P,10) P = P/10 WEXP(J:J) = CHAR(ICHAR('0')+K) J = J-1 GOTO 40 END IF WORK(ND+1:) = WEXP(J+1:10) ND = ND+10-J IF (WORK(1:3).EQ.'1'//TIMES) THEN TEMP = WORK(4:) WORK = TEMP ND = ND-3 END IF WORK(ND+1:ND+2) = DOWN ND = ND+2 END IF C C Add minus sign if necessary and move result to output. C IF (MINUS) THEN TEMP = WORK(1:ND) STRING = '-'//TEMP NC = ND+1 ELSE STRING = WORK(1:ND) NC = ND END IF C C Check result fits. C IF (NC.GT.LEN(STRING)) THEN STRING = '*' NC = 1 END IF END pgplot/src/grwarn.f010064400040640000322000000010000566021362200147610ustar00tjpcitmbr00000400000017C*GRWARN -- issue warning message to user C+ SUBROUTINE GRWARN (TEXT) CHARACTER*(*) TEXT C C Report a warning message on standard output, with prefix "%PGPLOT, ". C C Argument: C TEXT (input): text of message to be printed (the string C may not be blank). C-- C 8-Nov-1994 [TJP] C----------------------------------------------------------------------- INTEGER GRTRIM C IF (TEXT.NE.' ') THEN WRITE (*, '(1X,2A)') '%PGPLOT, ', TEXT(1:GRTRIM(TEXT)) END IF END pgplot/src/grpxps.f010064400040640000322000000041420634707625500150320ustar00tjpcitmbr00000400000017C*GRPXPS -- pixel dump for color or grey PostScript. C+ SUBROUTINE GRPXPS (IA, IDIM, JDIM, I1, I2, J1, J2, : XMIN, XMAX, YMIN, YMAX) INTEGER IDIM, JDIM, I1, I2, J1, J2 INTEGER IA(IDIM,JDIM) REAL XMIN, XMAX, YMIN, YMAX C C This routine is called by GRPIXL. C-- C 4-Apr-93 - Created from GRGRAY by Remko Scharroo - DUT/SSRT C 8-Apr-93 - Bugs fixed. C 6-Jul-94 - Aligned with PGPLOT V4.9H C 7-Sep-94 - updated for V5.0 [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I, J, NXP, NYP, NBUF, LCHR, II REAL DX,DY,RBUF(32) CHARACTER*32 CHR C----------------------------------------------------------------------- NXP = I2 - I1 + 1 NYP = J2 - J1 + 1 C C Build an image transformation matrix. C DX = (XMAX-XMIN)/NXP DY = (YMAX-YMIN)/NYP RBUF(1) = 0 RBUF(2) = NXP RBUF(3) = NYP RBUF(4) = GRXMIN(GRCIDE) RBUF(5) = GRXMAX(GRCIDE) RBUF(6) = GRYMIN(GRCIDE) RBUF(7) = GRYMAX(GRCIDE) RBUF(8) = 1.0/DX RBUF(9) = 0.0 RBUF(10) = 0.0 RBUF(11) = 1.0/DY RBUF(12) = (-XMIN)/DX RBUF(13) = (-YMIN)/DY C C Send setup info to driver. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC CALL GRTERM NBUF = 13 LCHR = 0 CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) C C Send the array of color indices to the driver. C II = 0 DO 20 J=J1,J2 DO 10 I=I1,I2 II = II + 1 RBUF(II+1) = IA(I,J) IF (II.EQ.20) THEN NBUF = II+1 RBUF(1) = II CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) II = 0 END IF 10 CONTINUE 20 CONTINUE IF (II.GT.0) THEN NBUF = II+1 RBUF(1) = II CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) II = 0 END IF C C Send termination code to driver. C NBUF = 1 RBUF(1) = -1 CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) C----------------------------------------------------------------------- END pgplot/src/grimg2.f010064400040640000322000000057720634707620400147020ustar00tjpcitmbr00000400000017C*GRIMG2 -- image of a 2D data array (pixel-primitive devices) C+ SUBROUTINE GRIMG2 (A, IDIM, JDIM, I1, I2, J1, J2, 1 A1, A2, PA, MININD, MAXIND, MODE) INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE REAL A(IDIM,JDIM) REAL A1, A2 REAL PA(6) C C (This routine is called by GRIMG0.) C-- C 7-Sep-1994 New routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I,IV,IX,IX1,IX2,IY,IY1,IY2,J, NPIX, LCHR REAL DEN, AV, SFAC, SFACL REAL XXAA,XXBB,YYAA,YYBB,XYAA,XYBB,YXAA,YXBB,XYAAIY,YXAAIY REAL BUFFER(1026) CHARACTER*1 CHR INTRINSIC NINT, LOG PARAMETER (SFAC=65000.0) C----------------------------------------------------------------------- C C Location of current window in device coordinates. C IX1 = NINT(GRXMIN(GRCIDE))+1 IX2 = NINT(GRXMAX(GRCIDE))-1 IY1 = NINT(GRYMIN(GRCIDE))+1 IY2 = NINT(GRYMAX(GRCIDE))-1 C C Transformation from array coordinates to device coordinates. C DEN = PA(2)*PA(6)-PA(3)*PA(5) XXAA = (-PA(6))*PA(1)/DEN XXBB = PA(6)/DEN XYAA = (-PA(3))*PA(4)/DEN XYBB = PA(3)/DEN YYAA = (-PA(2))*PA(4)/DEN YYBB = PA(2)/DEN YXAA = (-PA(5))*PA(1)/DEN YXBB = PA(5)/DEN C C Start a new page if necessary. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C C Run through every device pixel (IX, IY) in the current window and C determine which array pixel (I,J) it falls in. C SFACL = LOG(1.0+SFAC) DO 120 IY=IY1,IY2 XYAAIY = XXAA-XYAA-XYBB*IY YXAAIY = YYAA+YYBB*IY-YXAA NPIX = 0 BUFFER(2) = IY DO 110 IX=IX1,IX2 I = NINT(XYAAIY+XXBB*IX) IF (I.LT.I1.OR.I.GT.I2) GOTO 110 J = NINT(YXAAIY-YXBB*IX) IF (J.LT.J1.OR.J.GT.J2) GOTO 110 C C -- determine color index IV of this pixel C AV = A(I,J) IF (A2.GT.A1) THEN AV = MIN(A2, MAX(A1,AV)) ELSE AV = MIN(A1, MAX(A2,AV)) END IF IF (MODE.EQ.0) THEN IV = NINT((MININD*(A2-AV) + MAXIND*(AV-A1))/(A2-A1)) ELSE IF (MODE.EQ.1) THEN IV = MININD + NINT((MAXIND-MININD)* : LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL) ELSE IF (MODE.EQ.2) THEN IV = MININD + NINT((MAXIND-MININD)* : SQRT(ABS((AV-A1)/(A2-A1)))) ELSE IV = MININD END IF C IF (NPIX.LE.1024) THEN C -- drop pixels if buffer too small (to be fixed!) NPIX = NPIX+1 IF (NPIX.EQ.1) BUFFER(1) = IX BUFFER(NPIX+2) = IV END IF 110 CONTINUE IF (NPIX.GT.0) CALL : GREXEC(GRGTYP, 26, BUFFER, NPIX+2, CHR, LCHR) 120 CONTINUE C----------------------------------------------------------------------- END pgplot/src/grprom.f010064400040640000322000000006750562477306000150170ustar00tjpcitmbr00000400000017C*GRPROM -- prompt user before clearing screen C+ SUBROUTINE GRPROM C C If the program is running under control of a terminal, display C message and wait for the user to type before proceeding. C C Arguments: C none C-- C 18-Aug-1994 C----------------------------------------------------------------------- INTEGER IER, L, GRGCOM CHARACTER*16 JUNK C IER = GRGCOM(JUNK, 'Type for next page: ', L) END pgplot/src/grepic.f010064400040640000322000000010670566300147000147460ustar00tjpcitmbr00000400000017C*GREPIC -- end picture C+ SUBROUTINE GREPIC C C GRPCKG: End the current picture. C C Arguments: none. C-- C 17-Nov-1994 - [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER CHR C C Check a plot is open. C IF (GRCIDE.LT.1) RETURN C C End picture. C IF (GRPLTD(GRCIDE)) THEN RBUF(1) = 1. NBUF = 1 CALL GREXEC(GRGTYP,14,RBUF,NBUF,CHR,LCHR) END IF GRPLTD(GRCIDE) = .FALSE. C END pgplot/src/grimg3.f010064400040640000322000000055310634707677600147120ustar00tjpcitmbr00000400000017C*GRIMG3 -- gray-scale map of a 2D data array, using dither C+ SUBROUTINE GRIMG3 (A, IDIM, JDIM, I1, I2, J1, J2, 1 BLACK, WHITE, PA, MODE) INTEGER IDIM, JDIM, I1, I2, J1, J2, MODE REAL A(IDIM,JDIM) REAL BLACK, WHITE REAL PA(6) C-- C 2-Sep-1994 - moved from GRGRAY [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I,IX,IX1,IX2,IY,IY1,IY2,J REAL DEN,VALUE,BW REAL XXAA,XXBB,YYAA,YYBB,XYAA,XYBB,YXAA,YXBB,XYAAIY,YXAAIY INTEGER M, IAA, ICC, JRAN, ILAST, JLAST, IXSTEP, IYSTEP REAL RAND, RM, FAC, FACL PARAMETER (M=714025, IAA=1366, ICC=150889, RM=1.0/M) PARAMETER (FAC=65000.0) INTRINSIC MOD, NINT, REAL, LOG C----------------------------------------------------------------------- C IF (MODE.LT.0 .OR. MODE.GT.2) RETURN C C Initialize random-number generator (based on RAN2 of Press et al., C Numerical Recipes) C JRAN = 76773 C IX1 = NINT(GRXMIN(GRCIDE))+1 IX2 = NINT(GRXMAX(GRCIDE))-1 IY1 = NINT(GRYMIN(GRCIDE))+1 IY2 = NINT(GRYMAX(GRCIDE))-1 DEN = PA(2)*PA(6)-PA(3)*PA(5) C C Calculate constants. C BW = ABS(BLACK-WHITE) FACL = LOG(1.0+FAC) XXAA = (-PA(6))*PA(1)/DEN XXBB = PA(6)/DEN XYAA = (-PA(3))*PA(4)/DEN XYBB = PA(3)/DEN YYAA = (-PA(2))*PA(4)/DEN YYBB = PA(2)/DEN YXAA = (-PA(5))*PA(1)/DEN YXBB = PA(5)/DEN C C Choose step size: at least 1/200 inch, assuming the line-width C unit is 1/200 inch. C IXSTEP = MAX(1,NINT(GRWIDT(GRCIDE)*GRPXPI(GRCIDE)/200.0)) IYSTEP = MAX(1,NINT(GRWIDT(GRCIDE)*GRPYPI(GRCIDE)/200.0)) C C Draw dots. C ILAST = 0 JLAST = 0 DO 120 IY=IY1,IY2,IYSTEP XYAAIY = XXAA-XYAA-XYBB*IY YXAAIY = YYAA+YYBB*IY-YXAA DO 110 IX=IX1,IX2,IXSTEP I = NINT(XYAAIY+XXBB*IX) IF (I.LT.I1.OR.I.GT.I2) GOTO 110 J = NINT(YXAAIY-YXBB*IX) IF (J.LT.J1.OR.J.GT.J2) GOTO 110 IF (I.NE.ILAST .OR. J.NE.JLAST) THEN ILAST = I JLAST = J VALUE = ABS(A(I,J)-WHITE)/BW IF (MODE.EQ.0) THEN C -- "linear" CONTINUE ELSE IF (MODE.EQ.1) THEN C -- "logarithmic" VALUE = LOG(1.0+FAC*VALUE)/FACL ELSE IF (MODE.EQ.2) THEN C -- "square root" VALUE = SQRT(VALUE) END IF END IF JRAN = MOD(JRAN*IAA+ICC, M) RAND = JRAN*RM IF (VALUE.GT.RAND) CALL GRDOT0(REAL(IX),REAL(IY)) 110 CONTINUE 120 CONTINUE C----------------------------------------------------------------------- END )/DEN XYBB = PA(3)/DEN YYAA = (-PA(2))*PA(4)/DEN YYBB = PA(2)/DEN YXAA = (-PA(5))*PA(1)/DEN YXBB = PA(5)/DEN C C Choose step size: at leapgplot/src/grimg0.f010064400040640000322000000043020563345034300146610ustar00tjpcitmbr00000400000017C*GRIMG0 -- color image of a 2D data array C+ SUBROUTINE GRIMG0 (A, IDIM, JDIM, I1, I2, J1, J2, 1 A1, A2, PA, MININD, MAXIND, MODE) INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE REAL A(IDIM,JDIM), A1, A2, PA(6) C C This is a support routine for PGIMAG. C C Arguments: C A (input) : the array to be plotted. C IDIM (input) : the first dimension of array A. C JDIM (input) : the second dimension of array A. C I1, I2 (input) : the inclusive range of the first index C (I) to be plotted. C J1, J2 (input) : the inclusive range of the second C index (J) to be plotted. C A1 (input) : the array value which is to appear in color C index MININD. C A2 (input) : the array value which is to appear in color C index MAXIND. C PA (input) : transformation matrix between array grid and C device coordinates. C MININD (input) : minimum color index to use. C MAXIND (input) : maximum color index to use. C MODE (input) : =0 for linear, =1 for logarithmic, =2 for C square-root mapping of array values to color C indices. C-- C 7-Sep-1994 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' CHARACTER C C----------------------------------------------------------------------- C C Switch on type of device support. C C = GRGCAP(GRCIDE)(7:7) IF (C.EQ.'Q') THEN C -- Image-primitive devices CALL GRIMG1(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA, : MININD, MAXIND, MODE) ELSE IF (C.EQ.'P') THEN C -- Pixel-primitive devices CALL GRIMG2(A, IDIM, JDIM, I1, I2, J1, J2, A1, A2, PA, : MININD, MAXIND, MODE) ELSE IF (C.EQ.'N') THEN C -- Other devices CALL GRWARN( : 'images cannot be displayed on the selected device') ELSE C -- Unknown device code CALL GRWARN('unexpected error in routine GRIMG0') END IF C----------------------------------------------------------------------- END pgplot/src/grimg1.f010064400040640000322000000056300634707613500146750ustar00tjpcitmbr00000400000017C*GRIMG1 -- image of a 2D data array (image-primitive devices) C+ SUBROUTINE GRIMG1 (A, IDIM, JDIM, I1, I2, J1, J2, 1 A1, A2, PA, MININD, MAXIND, MODE) INTEGER IDIM, JDIM, I1, I2, J1, J2, MININD, MAXIND, MODE REAL A(IDIM,JDIM), A1, A2, PA(6) C C (This routine is called by GRIMG0.) C-- C 7-Sep-1994 New routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF, LCHR REAL RBUF(21), FAC, AV, SFAC, SFACL CHARACTER*1 CHR INTEGER I, J, II, NXP, NYP, IV INTRINSIC NINT, LOG PARAMETER (SFAC=65000.0) C----------------------------------------------------------------------- C Size of image. C NXP = I2 - I1 + 1 NYP = J2 - J1 + 1 RBUF(1) = 0.0 RBUF(2) = NXP RBUF(3) = NYP C C Clipping rectangle. C RBUF(4) = GRXMIN(GRCIDE) RBUF(5) = GRXMAX(GRCIDE) RBUF(6) = GRYMIN(GRCIDE) RBUF(7) = GRYMAX(GRCIDE) C C Image transformation matrix. C FAC = PA(2)*PA(6) - PA(3)*PA(5) RBUF(8) = PA(6)/FAC RBUF(9) = (-PA(5))/FAC RBUF(10) = (-PA(3))/FAC RBUF(11) = PA(2)/FAC RBUF(12) = (PA(3)*PA(4) - PA(1)*PA(6))/FAC - (I1-0.5) RBUF(13) = (PA(5)*PA(1) - PA(4)*PA(2))/FAC - (J1-0.5) C C Send setup info to driver. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC CALL GRTERM NBUF = 13 LCHR = 0 CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) C C Convert image array to color indices and send to driver. C SFACL = LOG(1.0+SFAC) II = 0 DO 20 J = J1,J2 DO 10 I = I1,I2 AV = A(I,J) IF (A2.GT.A1) THEN AV = MIN(A2, MAX(A1,AV)) ELSE AV = MIN(A1, MAX(A2,AV)) END IF IF (MODE.EQ.0) THEN IV = NINT((MININD*(A2-AV) + MAXIND*(AV-A1))/(A2-A1)) ELSE IF (MODE.EQ.1) THEN IV = MININD + NINT((MAXIND-MININD)* : LOG(1.0+SFAC*ABS((AV-A1)/(A2-A1)))/SFACL) ELSE IF (MODE.EQ.2) THEN IV = MININD + NINT((MAXIND-MININD)* : SQRT(ABS((AV-A1)/(A2-A1)))) ELSE IV = MININD END IF II = II + 1 RBUF(II+1) = IV IF (II.EQ.20) THEN NBUF = II + 1 RBUF(1) = II CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) II = 0 END IF 10 CONTINUE 20 CONTINUE IF (II.GT.0) THEN NBUF = II + 1 RBUF(1) = II CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) II = 0 END IF C C Send termination code to driver. C NBUF = 1 RBUF(1) = -1 CALL GREXEC(GRGTYP, 26, RBUF, NBUF, CHR, LCHR) C----------------------------------------------------------------------- END pgplot/src/grgfil.f010064400040640000322000000052400576743502300147560ustar00tjpcitmbr00000400000017C*GRGFIL -- find data file C+ SUBROUTINE GRGFIL(TYPE, NAME) CHARACTER*(*) TYPE, NAME C C This routine encsapsulates the algorithm for finding the PGPLOT C run-time data files. C C 1. The binary font file: try the following in order: C file specified by PGPLOT_FONT C file "grfont.dat" in directory specified by PGPLOT_DIR C (with or without '/' appended) C file "grfont.dat" in directory /usr/local/pgplot/ C C 2. The color-name database: try the following in order: C file specified by PGPLOT_RGB C file "rgb.txt" in directory specified by PGPLOT_DIR C (with or without '/' appended) C file "rgb.txt" in directory /usr/local/pgplot/ C C Arguments: C TYPE (input) : either 'FONT' or 'RGB' to request the corresponding C file. C NAME (output) : receives the file name. C-- C 2-Dec-1994 - new routine [TJP]. C----------------------------------------------------------------------- CHARACTER*(*) DEFDIR, DEFFNT, DEFRGB PARAMETER (DEFDIR='/usr/local/pgplot/') PARAMETER (DEFFNT='grfont.dat') PARAMETER (DEFRGB='rgb.txt') CHARACTER*255 FF CHARACTER*16 DEFLT INTEGER I, L, LD LOGICAL TEST, DEBUG C C Is debug output requested? C CALL GRGENV('DEBUG', FF, L) DEBUG = L.GT.0 C C Which file? C IF (TYPE.EQ.'FONT') THEN DEFLT = DEFFNT LD = LEN(DEFFNT) ELSE IF (TYPE.EQ.'RGB') THEN DEFLT = DEFRGB LD = LEN(DEFRGB) ELSE CALL GRWARN('Internal error in routine GRGFIL') END IF C C Try each possibility in turn. C DO 10 I=1,4 IF (I.EQ.1) THEN CALL GRGENV(TYPE, FF, L) ELSE IF (I.EQ.2) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:) = DEFLT L = L+LD END IF ELSE IF (I.EQ.3) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:L+1) = '/' FF(L+2:) = DEFLT L = L+1+LD END IF ELSE IF (I.EQ.4) THEN FF = DEFDIR//DEFLT L = LEN(DEFDIR)+LD END IF IF (L.GT.0) THEN IF (DEBUG) THEN CALL GRWARN('Looking for '//FF(:L)) END IF INQUIRE (FILE=FF(:L), EXIST=TEST) IF (TEST) THEN NAME = FF(:L) RETURN ELSE IF (DEBUG) THEN CALL GRWARN('WARNING: file not found') END IF END IF 10 CONTINUE C C Failed to find the file. C NAME = DEFLT C----------------------------------------------------------------------- END 16 DEFLT INTEGER I, L, LD LOGICAL TEST, DEBUG C C Is debug output requested? C CALL GRGENV('DEBUG', FF, L) DEBUG = L.GT.0 C C Which file? C IF (TYPE.EQ.'FONT') THEN DEFLT = DEFFNT LD = LEN(DEFFNT) ELSE IF (TYPE.EQ.'RGB') THEN DEFLT = DEFRGB LD = LEN(DEFRGB) ELSE CApgplot/src/pgctab.f010064400040640000322000000161710632462167400147500ustar00tjpcitmbr00000400000017C*PGCTAB -- install the color table to be used by PGIMAG C%void cpgctab(const float *l, const float *r, const float *g, \ C% const float *b, int nc, float contra, float bright); C+ SUBROUTINE PGCTAB(L, R, G, B, NC, CONTRA, BRIGHT) INTEGER NC REAL L(NC), R(NC), G(NC), B(NC), CONTRA, BRIGHT C C Use the given color table to change the color representations of C all color indexes marked for use by PGIMAG. To change which C color indexes are thus marked, call PGSCIR before calling PGCTAB C or PGIMAG. On devices that can change the color representations C of previously plotted graphics, PGCTAB will also change the colors C of existing graphics that were plotted with the marked color C indexes. This feature can then be combined with PGBAND to C interactively manipulate the displayed colors of data previously C plotted with PGIMAG. C C Limitations: C 1. Some devices do not propagate color representation changes C to previously drawn graphics. C 2. Some devices ignore requests to change color representations. C 3. The appearance of specific color representations on grey-scale C devices is device-dependent. C C Notes: C To reverse the sense of a color table, change the chosen contrast C and brightness to -CONTRA and 1-BRIGHT. C C In the following, the term 'color table' refers to the input C L,R,G,B arrays, whereas 'color ramp' refers to the resulting C ramp of colors that would be seen with PGWEDG. C C Arguments: C L (input) : An array of NC normalized ramp-intensity levels C corresponding to the RGB primary color intensities C in R(),G(),B(). Colors on the ramp are linearly C interpolated from neighbouring levels. C Levels must be sorted in increasing order. C 0.0 places a color at the beginning of the ramp. C 1.0 places a color at the end of the ramp. C Colors outside these limits are legal, but will C not be visible if CONTRA=1.0 and BRIGHT=0.5. C R (input) : An array of NC normalized red intensities. C G (input) : An array of NC normalized green intensities. C B (input) : An array of NC normalized blue intensities. C NC (input) : The number of color table entries. C CONTRA (input) : The contrast of the color ramp (normally 1.0). C Negative values reverse the direction of the ramp. C BRIGHT (input) : The brightness of the color ramp. This is normally C 0.5, but can sensibly hold any value between 0.0 C and 1.0. Values at or beyond the latter two C extremes, saturate the color ramp with the colors C of the respective end of the color table. C-- C 17-Sep-1994 - New routine [MCS]. C 14-Apr-1997 - Modified to implement a more conventional C interpretation of contrast and brightness [MCS]. C----------------------------------------------------------------------- INTEGER MININD, MAXIND, CI INTEGER NTOTAL, NSPAN INTEGER BELOW, ABOVE LOGICAL FORWRD REAL CA, CB, CIFRAC, SPAN REAL LEVEL REAL LDIFF, LFRAC REAL RED, GREEN, BLUE C C Set the minimum absolute contrast - this prevents a divide by zero. C REAL MINCTR PARAMETER (MINCTR = 1.0/256) C C No colormap entries? C IF(NC .EQ. 0) RETURN C C Determine the range of color indexes to be used. C CALL PGQCIR(MININD, MAXIND) C C Count the total number of color indexes to be processed. C NTOTAL = MAXIND - MININD + 1 C C No definable colors? C IF(NTOTAL .LT. 1 .OR. MININD .LT. 0) RETURN C C Prevent a divide by zero later by ensuring that CONTRA >= ABS(MINCTR). C IF(ABS(CONTRA) .LT. MINCTR) THEN CONTRA = SIGN(MINCTR, CONTRA) END IF C C Convert contrast to the normalized stretch of the C color table across the available color index range. C SPAN = 1.0 / ABS(CONTRA) C C Translate from brightness and contrast to the normalized color index C coordinates, CA and CB, at which to place the start and end of the C color table. C IF(CONTRA .GE. 0.0) THEN CA = 1.0 - BRIGHT * (1.0 + SPAN) CB = CA + SPAN ELSE CA = BRIGHT * (1.0 + SPAN) CB = CA - SPAN END IF C C Determine the number of color indexes spanned by the color table. C NSPAN = INT(SPAN * NTOTAL) C C Determine the direction in which the color table should be traversed. C FORWRD = CA .LE. CB C C Initialize the indexes at which to start searching the color table. C C Set the start index for traversing the table from NC to 1. C BELOW = NC C C Set the start index for traversing the table from 1 to NC. C ABOVE = 1 C C Buffer PGPLOT commands until the color map has been completely C installed. C CALL PGBBUF C C Linearly interpolate the color table RGB values onto each color index. C DO 1 CI=MININD, MAXIND C C Turn the color index into a fraction of the range MININD..MAXIND. C CIFRAC = REAL(CI-MININD) / REAL(MAXIND-MININD) C C Determine the color table position that corresponds to color index, C CI. C IF(NSPAN .GT. 0) THEN LEVEL = (CIFRAC-CA) / (CB-CA) ELSE IF(CIFRAC .LE. CA) THEN LEVEL = 0.0 ELSE LEVEL = 1.0 END IF END IF C C Search for the indexes of the two color table entries that straddle C LEVEL. The search algorithm assumes that values in L() are C arranged in increasing order. This allows us to search the color table C from the point at which the last search left off, rather than having C to search the whole color table each time. C IF(FORWRD) THEN 2 IF(ABOVE.LE.NC .AND. L(ABOVE).LT.LEVEL) THEN ABOVE = ABOVE + 1 GOTO 2 END IF BELOW = ABOVE - 1 ELSE 3 IF(BELOW.GE.1 .AND. L(BELOW).GT.LEVEL) THEN BELOW = BELOW - 1 GOTO 3 END IF ABOVE = BELOW + 1 END IF C C If the indexes lie outside the table, substitute the index of the C nearest edge of the table. C IF(BELOW .LT. 1) THEN LEVEL = 0.0 BELOW = 1 ABOVE = 1 ELSE IF(ABOVE .GT. NC) THEN LEVEL = 1.0 BELOW = NC ABOVE = NC END IF C C Linearly interpolate the primary color intensities from color table C entries, BELOW and ABOVE. C LDIFF = L(ABOVE) - L(BELOW) IF(LDIFF .GT. MINCTR) THEN LFRAC = (LEVEL - L(BELOW)) / LDIFF ELSE LFRAC = 0.0 END IF RED = R(BELOW) + (R(ABOVE) - R(BELOW)) * LFRAC GREEN = G(BELOW) + (G(ABOVE) - G(BELOW)) * LFRAC BLUE = B(BELOW) + (B(ABOVE) - B(BELOW)) * LFRAC C C Intensities are only defined between 0 and 1. C IF(RED .LT. 0.0) RED = 0.0 IF(RED .GT. 1.0) RED = 1.0 IF(GREEN .LT. 0.0) GREEN = 0.0 IF(GREEN .GT. 1.0) GREEN = 1.0 IF(BLUE .LT. 0.0) BLUE = 0.0 IF(BLUE .GT. 1.0) BLUE = 1.0 C C Install the new color representation. C CALL PGSCR(CI, RED, GREEN, BLUE) 1 CONTINUE C C Reveal the changed color map. C CALL PGEBUF RETURN END pgplot/src/grscr.f010064400040640000322000000046070600555402100146140ustar00tjpcitmbr00000400000017C*GRSCR -- set color representation C+ SUBROUTINE GRSCR (CI, CR, CG, CB) INTEGER CI REAL CR, CG, CB C C GRPCKG: SET COLOUR REPRESENTATION -- define the colour to be C associated with a colour index. Ignored for devices which do not C support variable colour or intensity. On monochrome output C devices (e.g. VT125 terminals with monochrome monitors), the C monochrome intensity is computed from the specified Red, Green, Blue C intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television C systems, NTSC encoding. Note that most devices do not have an C infinite range of colours or monochrome intensities available; C the nearest available colour is used. C C Arguments: C C CI (integer, input): colour index. If the colour index is outside the C range available on the device, the call is ignored. Colour C index 0 applies to the background colour. C CR, CG, CB (real, input): red, green, and blue intensities, C in range 0.0 to 1.0. C-- C 20-Feb-1984 - [TJP]. C 5-Jun-1984 - add GMFILE device [TJP]. C 2-Jul-1984 - add REGIS device [TJP]. C 2-Oct-1984 - change use of map tables in Regis [TJP]. C 11-Nov-1984 - add code for /TK [TJP]. C 1-Sep-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - If needed, calls begin picture [AFT]. C 31-Aug-1994 - suppress call of begin picture [TJP]. C 1-Sep-1994 - use common data [TJP]. C 26-Jul-1995 - fix bug: some drivers would ignore a change to the C current color [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER NBUF, LCHR REAL RBUF(6) CHARACTER CHR C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRSCR - Specified workstation is not open.') ELSE IF (CR.LT.0.0 .OR. CG.LT.0.0 .OR. CB.LT.0.0 .OR. 1 CR.GT.1.0 .OR. CG.GT.1.0 .OR. CB.GT.1.0) THEN CALL GRWARN('GRSCR - Colour is outside range [0,1].') ELSE IF (CI.GE.GRMNCI(GRCIDE) .AND. CI.LE.GRMXCI(GRCIDE)) THEN C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC RBUF(1)=CI RBUF(2)=CR RBUF(3)=CG RBUF(4)=CB NBUF=4 CALL GREXEC(GRGTYP,21,RBUF,NBUF,CHR,LCHR) C -- If this is the current color, reselect it in the driver. IF (CI.EQ.GRCCOL(GRCIDE)) THEN RBUF(1) = CI CALL GREXEC(GRGTYP,15,RBUF,NBUF,CHR,LCHR) END IF END IF C END pgplot/src/pglcur.f010064400040640000322000000104710600775003500147710ustar00tjpcitmbr00000400000017C*PGLCUR -- draw a line using the cursor C%void cpglcur(int maxpt, int *npt, float *x, float *y); C+ SUBROUTINE PGLCUR (MAXPT, NPT, X, Y) INTEGER MAXPT, NPT REAL X(*), Y(*) C C Interactive routine for user to enter a polyline by use of C the cursor. Routine allows user to Add and Delete vertices; C vertices are joined by straight-line segments. C C Arguments: C MAXPT (input) : maximum number of points that may be accepted. C NPT (in/out) : number of points entered; should be zero on C first call. C X (in/out) : array of x-coordinates (dimension at least MAXPT). C Y (in/out) : array of y-coordinates (dimension at least MAXPT). C C Notes: C C (1) On return from the program, cursor points are returned in C the order they were entered. Routine may be (re-)called with points C already defined in X,Y (# in NPT), and they will be plotted C first, before editing. C C (2) User commands: the user types single-character commands C after positioning the cursor: the following are accepted: C A (Add) - add point at current cursor location. C D (Delete) - delete last-entered point. C X (eXit) - leave subroutine. C-- C 5-Aug-1984 - new routine [TJP]. C 16-Jul-1988 - correct error in delete operation [TJP]. C 13-Dec-1990 - change warnings to messages [TJP]. C 3-Sep-1992 - fixed erase first point bug under Add option [JM/TJP]. C 7-Sep-1994 - use PGBAND [TJP]. C 2-Aug-1995 - remove dependence on common block [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO CHARACTER*1 LETTER INTEGER PGBAND, I, SAVCOL, MODE REAL XP, YP, XREF, YREF REAL XBLC, XTRC, YBLC, YTRC C C Check that PGPLOT is in the correct state. C IF (PGNOTO('PGLCUR')) RETURN C C Save current color. C CALL GRQCI(SAVCOL) C C Put current line-segments on screen. C IF (NPT.EQ.1) THEN CALL PGPT(1,X(1),Y(1),1) END IF IF (NPT.GT.0) THEN CALL GRMOVA(X(1),Y(1)) DO 10 I=2,NPT CALL GRLINA(X(I),Y(I)) 10 CONTINUE END IF C C Start with the cursor in the middle of the box, C unless lines have already been drawn. C CALL PGQWIN(XBLC, XTRC, YBLC, YTRC) IF (NPT.GT.0) THEN XP = X(NPT) YP = Y(NPT) ELSE XP = 0.5*(XBLC+XTRC) YP = 0.5*(YBLC+YTRC) END IF C C Loop over cursor inputs. C MODE = 0 100 XREF = XP YREF = YP IF (PGBAND(MODE,1,XREF,YREF,XP,YP,LETTER).NE.1) RETURN CALL GRTOUP(LETTER,LETTER) MODE = 1 C C A (ADD) command: C IF (LETTER .EQ. 'A') THEN IF (NPT.GE.MAXPT) THEN CALL GRMSG('ADD ignored (too many points).') GOTO 100 END IF NPT = NPT+1 X(NPT) = XP Y(NPT) = YP IF (NPT.EQ.1) THEN C -- first point: draw a dot CALL GRMOVA(X(NPT),Y(NPT)) CALL PGPT(1,X(NPT),Y(NPT),1) ELSE C -- nth point: draw from (n-1) to (n) CALL GRLINA(X(NPT),Y(NPT)) END IF CALL GRTERM C C D (DELETE) command: C ELSE IF (LETTER.EQ.'D') THEN IF (NPT.LE.0) THEN CALL GRMSG('DELETE ignored (there are no points left).') GOTO 100 END IF IF (NPT.GT.1) THEN C -- delete nth point: erase from (n-1) to (n) CALL GRMOVA(X(NPT-1),Y(NPT-1)) CALL GRSCI(0) CALL GRLINA(X(NPT),Y(NPT)) CALL GRSCI(SAVCOL) CALL GRMOVA(X(NPT-1),Y(NPT-1)) CALL GRTERM ELSE IF (NPT.EQ.1) THEN C -- delete first point: erase dot CALL GRSCI(0) CALL PGPT(1,X(NPT),Y(NPT),1) CALL GRSCI(SAVCOL) END IF NPT = NPT-1 IF (NPT.EQ.0) THEN XP = 0.5*(XBLC+XTRC) YP = 0.5*(YBLC+YTRC) ELSE XP = X(NPT) YP = Y(NPT) END IF IF (NPT.EQ.1) THEN C -- delete 2nd point: redraw dot at first point CALL PGPT(1,X(1),Y(1),1) END IF C C X (EXIT) command: C ELSE IF (LETTER.EQ.'X') THEN CALL GRETXT RETURN C C Illegal command: C ELSE CALL GRMSG('Commands are A (add), D (delete), X (exit).') END IF C GOTO 100 END pgplot/src/pgolin.f010064400040640000322000000066560600775073500150060ustar00tjpcitmbr00000400000017C*PGOLIN -- mark a set of points using the cursor C%void cpgolin(int maxpt, int *npt, float *x, float *y, int symbol); C+ SUBROUTINE PGOLIN (MAXPT, NPT, X, Y, SYMBOL) INTEGER MAXPT, NPT REAL X(*), Y(*) INTEGER SYMBOL C C Interactive routine for user to enter data points by use of C the cursor. Routine allows user to Add and Delete points. The C points are returned in the order that they were entered (unlike C PGNCUR). C C Arguments: C MAXPT (input) : maximum number of points that may be accepted. C NPT (in/out) : number of points entered; should be zero on C first call. C X (in/out) : array of x-coordinates. C Y (in/out) : array of y-coordinates. C SYMBOL (input) : code number of symbol to use for marking C entered points (see PGPT). C C Note (1): The dimension of arrays X and Y must be greater than or C equal to MAXPT. C C Note (2): On return from the program, cursor points are returned in C the order they were entered. Routine may be (re-)called with points C already defined in X,Y (number in NPT), and they will be plotted C first, before editing. C C Note (3): User commands: the user types single-character commands C after positioning the cursor: the following are accepted: C A (Add) - add point at current cursor location. C D (Delete) - delete the last point entered. C X (eXit) - leave subroutine. C-- C 4-Nov-1985 - new routine (adapted from PGNCUR) - TJP. C 13-Dec-1990 - change warnings to messages [TJP]. C 7-Sep-1994 - use PGBAND [TJP]. C 2-Aug-1995 - remove dependence on common block [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO CHARACTER*1 LETTER INTEGER PGBAND, SAVCOL REAL XP, YP, XREF, YREF REAL XBLC, XTRC, YBLC, YTRC C C Check that PGPLOT is in the correct state. C IF (PGNOTO('PGOLIN')) RETURN C C Save current color. C CALL GRQCI(SAVCOL) C C Put current points on screen. Position cursor on last point, C or in middle viewport if there are no current points. C CALL PGQWIN(XBLC, XTRC, YBLC, YTRC) IF (NPT.NE.0) THEN CALL PGPT(NPT,X,Y,SYMBOL) XP = X(NPT) YP = Y(NPT) ELSE XP = 0.5*(XBLC+XTRC) YP = 0.5*(YBLC+YTRC) END IF C C Loop over cursor inputs. C 100 XREF = XP YREF = YP IF (PGBAND(0,1,XREF,YREF,XP,YP,LETTER).NE.1) RETURN IF (LETTER.EQ.CHAR(0)) RETURN CALL GRTOUP(LETTER,LETTER) C C A (ADD) command: C IF (LETTER .EQ. 'A') THEN IF (NPT.GE.MAXPT) THEN CALL GRMSG('ADD ignored (too many points).') ELSE NPT = NPT + 1 X(NPT) = XP Y(NPT) = YP CALL PGPT(1,X(NPT),Y(NPT),SYMBOL) CALL GRTERM END IF C C D (DELETE) command: C ELSE IF (LETTER.EQ.'D') THEN IF (NPT.LE.0) THEN CALL GRMSG('DELETE ignored (there are no points left).') ELSE CALL GRSCI(0) CALL PGPT(1,X(NPT),Y(NPT),SYMBOL) XP = X(NPT) YP = Y(NPT) CALL GRSCI(SAVCOL) CALL GRTERM NPT = NPT-1 END IF C C X (EXIT) command: C ELSE IF (LETTER.EQ.'X') THEN CALL GRETXT RETURN C C Illegal command: C ELSE CALL GRMSG('Commands are A (add), D (delete), X (exit).') END IF C GOTO 100 END ed from PGNCUR) - TJP. C 13-Dec-1990 - change warnings to messages [TJP]. C 7-Seppgplot/src/pgsci.f010064400040640000322000000027540600776031500146110ustar00tjpcitmbr00000400000017C*PGSCI -- set color index C%void cpgsci(int ci); C+ SUBROUTINE PGSCI (CI) INTEGER CI C C Set the Color Index for subsequent plotting, if the output device C permits this. The default color index is 1, usually white on a black C background for video displays or black on a white background for C printer plots. The color index is an integer in the range 0 to a C device-dependent maximum. Color index 0 corresponds to the background C color; lines may be "erased" by overwriting them with color index 0 C (if the device permits this). C C If the requested color index is not available on the selected device, C color index 1 will be substituted. C C The assignment of colors to color indices can be changed with C subroutine PGSCR (set color representation). Color indices 0-15 C have predefined color representations (see the PGPLOT manual), but C these may be changed with PGSCR. Color indices above 15 have no C predefined representations: if these indices are used, PGSCR must C be called to define the representation. C C Argument: C CI (input) : the color index to be used for subsequent plotting C on the current device (in range 0-max). If the C index exceeds the device-dependent maximum, the C default color index (1) is used. C-- C 26-Sep-1985 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGSCI')) RETURN CALL GRSCI(CI) END pgplot/src/pgscr.f010064400040640000322000000033320600776035300146150ustar00tjpcitmbr00000400000017C*PGSCR -- set color representation C%void cpgscr(int ci, float cr, float cg, float cb); C+ SUBROUTINE PGSCR (CI, CR, CG, CB) INTEGER CI REAL CR, CG, CB C C Set color representation: i.e., define the color to be C associated with a color index. Ignored for devices which do not C support variable color or intensity. Color indices 0-15 C have predefined color representations (see the PGPLOT manual), but C these may be changed with PGSCR. Color indices 16-maximum have no C predefined representations: if these indices are used, PGSCR must C be called to define the representation. On monochrome output C devices (e.g. VT125 terminals with monochrome monitors), the C monochrome intensity is computed from the specified Red, Green, Blue C intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television C systems, NTSC encoding. Note that most devices do not have an C infinite range of colors or monochrome intensities available; C the nearest available color is used. Examples: for black, C set CR=CG=CB=0.0; for white, set CR=CG=CB=1.0; for medium gray, C set CR=CG=CB=0.5; for medium yellow, set CR=CG=0.5, CB=0.0. C C Argument: C CI (input) : the color index to be defined, in the range 0-max. C If the color index greater than the device C maximum is specified, the call is ignored. Color C index 0 applies to the background color. C CR (input) : red, green, and blue intensities, C CG (input) in range 0.0 to 1.0. C CB (input) C-- C 5-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGSCR')) RETURN CALL GRSCR(CI,CR,CG,CB) END pgplot/src/pgslw.f010064400040640000322000000015000600776043200146240ustar00tjpcitmbr00000400000017C*PGSLW -- set line width C%void cpgslw(int lw); C+ SUBROUTINE PGSLW (LW) INTEGER LW C C Set the line-width attribute. This attribute affects lines, graph C markers, and text. The line width is specified in units of 1/200 C (0.005) inch (about 0.13 mm) and must be an integer in the range C 1-201. On some devices, thick lines are generated by tracing each C line with multiple strokes offset in the direction perpendicular to C the line. C C Argument: C LW (input) : width of line, in units of 0.005 inch (0.13 mm) C in range 1-201. C-- C 8-Aug-1985 - new routine, equivalent to GRSLW [TJP]. C 1-Feb-1995 - change comment [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGSLW')) RETURN CALL GRSLW(LW) END pgplot/src/pgscf.f010064400040640000322000000016560600776067700146210ustar00tjpcitmbr00000400000017C*PGSCF -- set character font C%void cpgscf(int font); C+ SUBROUTINE PGSCF (FONT) INTEGER FONT C C Set the Character Font for subsequent text plotting. Four different C fonts are available: C 1: (default) a simple single-stroke font ("normal" font) C 2: roman font C 3: italic font C 4: script font C This call determines which font is in effect at the beginning of C each text string. The font can be changed (temporarily) within a text C string by using the escape sequences \fn, \fr, \fi, and \fs for fonts C 1, 2, 3, and 4, respectively. C C Argument: C FONT (input) : the font number to be used for subsequent text C plotting (in range 1-4). C-- C 26-Sep-1985 - new routine [TJP]. C 25-OCT-1993 - changed name of argument [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGSCF')) RETURN CALL GRSFNT(FONT) END pgplot/src/pgsls.f010064400040640000322000000015000600776047700146310ustar00tjpcitmbr00000400000017C*PGSLS -- set line style C%void cpgsls(int ls); C+ SUBROUTINE PGSLS (LS) INTEGER LS C C Set the line style attribute for subsequent plotting. This C attribute affects line primitives only; it does not affect graph C markers, text, or area fill. C Five different line styles are available, with the following codes: C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted), C 5 (dash-dot-dot-dot). The default is 1 (normal full line). C C Argument: C LS (input) : the line-style code for subsequent plotting C (in range 1-5). C-- C 8-Aug-1985 - new routine, equivalent to GRSLS [TJP]. C 3-Jun-1984 - add GMFILE device [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGSLS')) RETURN CALL GRSLS(LS) END g codes: C 1 (full line), 2 (dashed), 3 (dot-dash-dot-dash), 4 (dotted), C 5 (dash-dot-dot-dot). The default is 1 (normal full line). C C Argument: C LS (input) : the line-style code forpgplot/src/pgqcf.f010064400040640000322000000010410600776076700146030ustar00tjpcitmbr00000400000017C*PGQCF -- inquire character font C%void cpgqcf(int *font); C+ SUBROUTINE PGQCF (FONT) INTEGER FONT C C Query the current Character Font (set by routine PGSCF). C C Argument: C FONT (output) : the current font number (in range 1-4). C-- C 5-Nov-1985 - new routine [TJP]. C 25-OCT-1993 - changed name of argument [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGQCF')) THEN FONT = 1 ELSE CALL GRQFNT(FONT) END IF END pgplot/src/pgqls.f010064400040640000322000000007570600776103200146300ustar00tjpcitmbr00000400000017C*PGQLS -- inquire line style C%void cpgqls(int *ls); C+ SUBROUTINE PGQLS (LS) INTEGER LS C C Query the current Line Style attribute (set by routine PGSLS). C C Argument: C LS (output) : the current line-style attribute (in range 1-5). C-- C 5-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGQLS')) THEN LS = 1 ELSE CALL GRQLS(LS) END IF END pgplot/src/pgqlw.f010064400040640000322000000007450600776126300146370ustar00tjpcitmbr00000400000017C*PGQLW -- inquire line width C%void cpgqlw(int *lw); C+ SUBROUTINE PGQLW (LW) INTEGER LW C C Query the current Line-Width attribute (set by routine PGSLW). C C Argument: C LW (output) : the line-width (in range 1-201). C-- C 5-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGQLW')) THEN LW = 1 ELSE CALL GRQLW(LW) END IF END pgplot/src/pgqci.f010064400040640000322000000012730600776123500146040ustar00tjpcitmbr00000400000017C*PGQCI -- inquire color index C%void cpgqci(int *ci); C+ SUBROUTINE PGQCI (CI) INTEGER CI C C Query the Color Index attribute (set by routine PGSCI). C C Argument: C CI (output) : the current color index (in range 0-max). This is C the color index actually in use, and may differ C from the color index last requested by PGSCI if C that index is not available on the output device. C-- C 5-Nov-1985 - new routine [TJP]. C----------------------------------------------------------------------- LOGICAL PGNOTO C IF (PGNOTO('PGQCI')) THEN CI = 1 ELSE CALL GRQCI(CI) END IF END pgplot/src/pgcl.f010064400040640000322000000053450602037322400144220ustar00tjpcitmbr00000400000017C SUBROUTINE PGCL (K, X, Y, Z) INTEGER K REAL X, Y, Z C C PGPLOT (internal routine): Label one contour segment (for use by C PGCONX). C C Arguments: C C K (input, integer): if K=0, move the pen to (X,Y); if K=1, draw C a line from the current position to (X,Y); otherwise C do nothing. C X (input, real): X world-coordinate of end point. C Y (input, real): Y world-coordinate of end point. C Z (input, real): the value of the contour level, not used by PGCL. C-- C 5-May-1994 - new routine [TJP] C 7-Mar-1995 - correct error in angle; do not draw labels outside C window [TJP]. C 28-Aug-1995 - check arguments of atan2 [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' REAL XX, YY, XC, YC, XV1, XV2, YV1, YV2, XL, XR, YB, YT REAL XN, YN REAL ANGLE, XO, YO, XP, YP, DINDX, DINDY, XBOX(4), YBOX(4) INTEGER I, TB SAVE I DATA I /0/ C C -- transform to world coordinates XX = TRANS(1) + TRANS(2)*X + TRANS(3)*Y YY = TRANS(4) + TRANS(5)*X + TRANS(6)*Y C IF (K.EQ.0) THEN C -- start of contour: reset segment counter I = 0 ELSE C -- increment segment counter and check whether this C segment should be labelled I = MOD(I+1,PGCINT) IF (I.EQ.PGCMIN) THEN C -- find center of this segment (XC, YC) CALL PGQPOS(XP, YP) XC = (XX+XP)*0.5 YC = (YY+YP)*0.5 C -- find slope of this segment (ANGLE) CALL PGQVP(1, XV1, XV2, YV1, YV2) CALL PGQWIN(XL, XR, YB, YT) ANGLE = 0.0 IF (XR.NE.XL .AND. YT.NE.YB) THEN DINDX = (XV2 - XV1) / (XR - XL) DINDY = (YV2 - YV1) / (YT - YB) IF (YY-YP.NE.0.0 .OR. XX-XP.NE.0.0) : ANGLE = 57.3*ATAN2((YY-YP)*DINDY, (XX-XP)*DINDX) END IF C -- check whether point is in window XN = (XC-XL)/(XR-XL) YN = (YC-YB)/(YT-YB) IF (XN.GE.0.0 .AND. XN.LE.1.0 .AND. : YN.GE.0.0 .AND. YN.LE.1.0) THEN C -- save current text background and set to erase CALL PGQTBG(TB) CALL PGSTBG(0) C -- find bounding box of label CALL PGQTXT(XC, YC, ANGLE, 0.5, PGCLAB, XBOX, YBOX) XO = 0.5*(XBOX(1)+XBOX(3)) YO = 0.5*(YBOX(1)+YBOX(3)) C -- plot label with bounding box centered at (XC, YC) CALL PGPTXT(2.0*XC-XO, 2.0*YC-YO, ANGLE, 0.5, PGCLAB) C -- restore text background CALL PGSTBG(TB) END IF END IF END IF CALL PGMOVE(XX,YY) END pgplot/src/pgadvance.f010064400040640000322000000002120603203721100154050ustar00tjpcitmbr00000400000017C*PGADVANCE -- non-standard alias for PGPAGE C+ SUBROUTINE PGADVANCE C C See description of PGPAGE. C-- CALL PGPAGE END pgplot/src/pgbegin.f010064400040640000322000000004640603203732200151040ustar00tjpcitmbr00000400000017C*PGBEGIN -- non-standard alias for PGBEG C+ INTEGER FUNCTION PGBEGIN (UNIT, FILE, NXSUB, NYSUB) INTEGER UNIT CHARACTER*(*) FILE INTEGER NXSUB, NYSUB C C See description of PGBEG. C-- INTEGER PGBEG PGBEGIN = PGBEG (UNIT, FILE, NXSUB, NYSUB) END pgplot/src/pgcurse.f010064400040640000322000000003410603203735000151340ustar00tjpcitmbr00000400000017C*PGCURSE -- non-standard alias for PGCURS C+ INTEGER FUNCTION PGCURSE (X, Y, CH) REAL X, Y CHARACTER*1 CH C C See description of PGCURS. C-- INTEGER PGCURS PGCURSE = PGCURS (X, Y, CH) END pgplot/src/pglabel.f010064400040640000322000000003240603203737000150750ustar00tjpcitmbr00000400000017C*PGLABEL -- non-standard alias for PGLAB C+ SUBROUTINE PGLABEL (XLBL, YLBL, TOPLBL) CHARACTER*(*) XLBL, YLBL, TOPLBL C C See description of PGLAB. C-- CALL PGLAB (XLBL, YLBL, TOPLBL) END pgplot/src/pgmtext.f010064400040640000322000000004050603203741300151550ustar00tjpcitmbr00000400000017C*PGMTEXT -- non-standard alias for PGMTXT C+ SUBROUTINE PGMTEXT (SIDE, DISP, COORD, FJUST, TEXT) CHARACTER*(*) SIDE, TEXT REAL DISP, COORD, FJUST C C See description of PGMTXT. C-- CALL PGMTXT (SIDE, DISP, COORD, FJUST, TEXT) END pgplot/src/pgncurse.f010064400040640000322000000004050603203755600153230ustar00tjpcitmbr00000400000017C*PGNCURSE -- non-standard alias for PGNCUR C+ SUBROUTINE PGNCURSE (MAXPT, NPT, X, Y, SYMBOL) INTEGER MAXPT, NPT REAL X(*), Y(*) INTEGER SYMBOL C C See description of PGNCUR. C-- CALL PGNCUR (MAXPT, NPT, X, Y, SYMBOL) END pgplot/src/pgpaper.f010064400040640000322000000002740603203761500151330ustar00tjpcitmbr00000400000017C*PGPAPER -- non-standard alias for PGPAP C+ SUBROUTINE PGPAPER (WIDTH, ASPECT) REAL WIDTH, ASPECT C C See description of PGPAP. C-- CALL PGPAP (WIDTH, ASPECT) END pgplot/src/gresc.f010064400040640000322000000020210627570130300145710ustar00tjpcitmbr00000400000017C*GRESC -- escape routine C+ SUBROUTINE GRESC (TEXT) C C GRPCKG: "Escape" routine. The specified text is sent directly to the C selected graphics device, with no interpretation by GRPCKG. This C routine must be used with care; e.g., the programmer needs to know C the device type of the currently selected device, and the instructions C that that device can accept. C C Arguments: none. C TEXT (input, character*(*)): text to be sent to the device. C C 15-May-1985 - new routine [TJP]. C 26-May-1987 - add GREXEC support [TJP]. C 19-Dec-1988 - start new page if necessary [TJP]. C 4-Feb-1997 - RBUF should be an array, not a scalar [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' CHARACTER*(*) TEXT REAL RBUF(1) INTEGER NBUF C C If no device is currently selected, do nothing. C IF (GRCIDE.GT.0) THEN IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC NBUF = 0 CALL GREXEC(GRGTYP,23,RBUF,NBUF,TEXT,LEN(TEXT)) END IF END pgplot/src/pgpoint.f010064400040640000322000000003610603203763200151510ustar00tjpcitmbr00000400000017C*PGPOINT -- non-standard alias for PGPT C+ SUBROUTINE PGPOINT (N, XPTS, YPTS, SYMBOL) INTEGER N REAL XPTS(*), YPTS(*) INTEGER SYMBOL C C See description of PGPT. C-- CALL PGPT (N, XPTS, YPTS, SYMBOL) END pgplot/src/pgptext.f010064400040640000322000000003630603203765200151700ustar00tjpcitmbr00000400000017C*PGPTEXT -- non-standard alias for PGPTXT C+ SUBROUTINE PGPTEXT (X, Y, ANGLE, FJUST, TEXT) REAL X, Y, ANGLE, FJUST CHARACTER*(*) TEXT C C See description of PGPTXT. C-- CALL PGPTXT (X, Y, ANGLE, FJUST, TEXT) END pgplot/src/pgvport.f010064400040640000322000000003400603203767200151730ustar00tjpcitmbr00000400000017C*PGVPORT -- non-standard alias for PGSVP C+ SUBROUTINE PGVPORT (XLEFT, XRIGHT, YBOT, YTOP) REAL XLEFT, XRIGHT, YBOT, YTOP C C See description of PGSVP. C-- CALL PGSVP (XLEFT, XRIGHT, YBOT, YTOP) END pgplot/src/pgvsize.f010064400040640000322000000003430603203772300151610ustar00tjpcitmbr00000400000017C*PGVSIZE -- non-standard alias for PGVSIZ C+ SUBROUTINE PGVSIZE (XLEFT, XRIGHT, YBOT, YTOP) REAL XLEFT, XRIGHT, YBOT, YTOP C C See description of PGVSIZ. C-- CALL PGVSIZ (XLEFT, XRIGHT, YBOT, YTOP) END pgplot/src/pgvstand.f010064400040640000322000000002100603203775300153140ustar00tjpcitmbr00000400000017C*PGVSTAND -- non-standard alias for PGVSTD C+ SUBROUTINE PGVSTAND C C See description of PGVSTD. C-- CALL PGVSTD END pgplot/src/pgwindow.f010064400040640000322000000003040603203777100153300ustar00tjpcitmbr00000400000017C*PGWINDOW -- non-standard alias for PGSWIN C+ SUBROUTINE PGWINDOW (X1, X2, Y1, Y2) REAL X1, X2, Y1, Y2 C C See description of PGSWIN. C-- CALL PGSWIN (X1, X2, Y1, Y2) END pgplot/src/grlin0.f010064400040640000322000000025010604126114200146550ustar00tjpcitmbr00000400000017C*GRLIN0 -- draw a line C+ SUBROUTINE GRLIN0 (XP,YP) C C GRPCKG (internal routine): draw a line from the current position to a C specified position, which becomes the new current position. This C routine takes care of clipping at the viewport boundary, dashed and C thick lines. C C Arguments: C C XP, YP (input, real): absolute device coordinates of the end-point of C the line. C-- C 13-Jul-1984 C 7-May-1985 - add MIN/MAX kluge to prevent integer overflow [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL VIS REAL XP,YP, X0,Y0, X1,Y1 C C End-points of line are (X0,Y0), (X1,Y1). C X0 = GRXPRE(GRCIDE) Y0 = GRYPRE(GRCIDE) X1 = MIN(2E9,MAX(-2E9,XP)) Y1 = MIN(2E9,MAX(-2E9,YP)) GRXPRE(GRCIDE) = X1 GRYPRE(GRCIDE) = Y1 C C Change the end-points of the line (X0,Y0) - (X1,Y1) C to clip the line at the window boundary. C CALL GRCLPL(X0,Y0,X1,Y1,VIS) IF (.NOT.VIS) RETURN C C Draw the line in the appropriate style. C IF (GRDASH(GRCIDE)) THEN C ! dashed line CALL GRLIN1(X0,Y0,X1,Y1,.FALSE.) ELSE IF (GRWIDT(GRCIDE).GT.1) THEN C ! heavy line CALL GRLIN3(X0,Y0,X1,Y1) ELSE C ! full line CALL GRLIN2(X0,Y0,X1,Y1) END IF END pgplot/src/grldev.f010064400040640000322000000016200605074630100147530ustar00tjpcitmbr00000400000017C*GRLDEV -- list supported device types C+ SUBROUTINE GRLDEV C C Support routine for PGLDEV. C C Arguments: none C-- C 5-Aug-1986 [AFT] C 13-Dec-1990 Change warnings to messages [TJP]. C 18-Jan-1993 Display one per line [TJP]. C 13-Jan-1995 Change message [TJP]. C 10-Nov-1995 Ignore device types of zero length [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I,NDEV,NBUF,LCHR REAL RBUF(6) CHARACTER*72 CHR CHARACTER*72 TEXT C--- CALL GRMSG('Device types available:') C--- First obtain number of devices. CALL GREXEC(0,0,RBUF,NBUF,CHR,LCHR) NDEV=NINT(RBUF(1)) C DO 10 I=1,NDEV CALL GREXEC(I, 1,RBUF,NBUF,CHR,LCHR) IF (LCHR.GT.0) THEN TEXT(1:1) = '/' TEXT(2:) = CHR(:LCHR) CALL GRMSG(TEXT) END IF 10 CONTINUE C END pgplot/src/pgconx.f010064400040640000322000000124140614171247300147750ustar00tjpcitmbr00000400000017C*PGCONX -- contour map of a 2D data array (non rectangular) C+ SUBROUTINE PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, C, NC, PLOT) INTEGER IDIM, JDIM, I1, J1, I2, J2, NC REAL A(IDIM,JDIM), C(*) EXTERNAL PLOT C C Draw a contour map of an array using a user-supplied plotting C routine. This routine should be used instead of PGCONT when the C data are defined on a non-rectangular grid. PGCONT permits only C a linear transformation between the (I,J) grid of the array C and the world coordinate system (x,y), but PGCONX permits any C transformation to be used, the transformation being defined by a C user-supplied subroutine. The nature of the contouring algorithm, C however, dictates that the transformation should maintain the C rectangular topology of the grid, although grid-points may be C allowed to coalesce. As an example of a deformed rectangular C grid, consider data given on the polar grid theta=0.1n(pi/2), C for n=0,1,...,10, and r=0.25m, for m=0,1,..,4. This grid C contains 55 points, of which 11 are coincident at the origin. C The input array for PGCONX should be dimensioned (11,5), and C data values should be provided for all 55 elements. PGCONX can C also be used for special applications in which the height of the C contour affects its appearance, e.g., stereoscopic views. C C The map is truncated if necessary at the boundaries of the viewport. C Each contour line is drawn with the current line attributes (color C index, style, and width); except that if argument NC is positive C (see below), the line style is set by PGCONX to 1 (solid) for C positive contours or 2 (dashed) for negative contours. Attributes C for the contour lines can also be set in the user-supplied C subroutine, if desired. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1, I2 (input) : range of first index to be contoured (inclusive). C J1, J2 (input) : range of second index to be contoured (inclusive). C C (input) : array of NC contour levels; dimension at least NC. C NC (input) : +/- number of contour levels (less than or equal C to dimension of C). If NC is positive, it is the C number of contour levels, and the line-style is C chosen automatically as described above. If NC is C negative, it is minus the number of contour C levels, and the current setting of line-style is C used for all the contours. C PLOT (input) : the address (name) of a subroutine supplied by C the user, which will be called by PGCONX to do C the actual plotting. This must be declared C EXTERNAL in the program unit calling PGCONX. C C The subroutine PLOT will be called with four arguments: C CALL PLOT(VISBLE,X,Y,Z) C where X,Y (input) are real variables corresponding to C I,J indices of the array A. If VISBLE (input, integer) is 1, C PLOT should draw a visible line from the current pen C position to the world coordinate point corresponding to (X,Y); C if it is 0, it should move the pen to (X,Y). Z is the value C of the current contour level, and may be used by PLOT if desired. C Example: C SUBROUTINE PLOT (VISBLE,X,Y,Z) C REAL X, Y, Z, XWORLD, YWORLD C INTEGER VISBLE C XWORLD = X*COS(Y) ! this is the user-defined C YWORLD = X*SIN(Y) ! transformation C IF (VISBLE.EQ.0) THEN C CALL PGMOVE (XWORLD, YWORLD) C ELSE C CALL PGDRAW (XWORLD, YWORLD) C END IF C END C-- C 14-Nov-1985 - new routine [TJP]. C 12-Sep-1989 - correct documentation error [TJP]. C 22-Apr-1990 - corrected bug in panelling algorithm [TJP]. C 13-Dec-1990 - make errors non-fatal [TJP]. C----------------------------------------------------------------------- INTEGER MAXEMX,MAXEMY PARAMETER (MAXEMX=100) PARAMETER (MAXEMY=100) INTEGER I INTEGER NNX,NNY, KX,KY, KI,KJ, IA,IB, JA,JB, LS, PX, PY LOGICAL STYLE, PGNOTO C C Check arguments. C IF (PGNOTO('PGCONX')) RETURN IF (I1.LT.1 .OR. I2.GT.IDIM .OR. I1.GE.I2 .OR. 1 J1.LT.1 .OR. J2.GT.JDIM .OR. J1.GE.J2) THEN CALL GRWARN('PGCONX: invalid range I1:I2, J1:J2') RETURN END IF IF (NC.EQ.0) RETURN STYLE = NC.GT.0 CALL PGQLS(LS) CALL PGBBUF C C Divide arrays into panels not exceeding MAXEMX by MAXEMY for C contouring by PGCNSC. C CD write (*,*) 'PGCONX window:',i1,i2,j1,j2 NNX = I2-I1+1 NNY = J2-J1+1 KX = MAX(1,(NNX+MAXEMX-2)/(MAXEMX-1)) KY = MAX(1,(NNY+MAXEMY-2)/(MAXEMY-1)) PX = (NNX+KX-1)/KX PY = (NNY+KY-1)/KY DO 60 KI=1,KX IA = I1 + (KI-1)*PX IB = MIN(I2, IA + PX) DO 50 KJ=1,KY JA = J1 + (KJ-1)*PY JB = MIN(J2, JA + PY) C C Draw the contours in one panel. C CD write (*,*) 'PGCONX panel:',ia,ib,ja,jb IF (STYLE) CALL PGSLS(1) DO 40 I=1,ABS(NC) IF (STYLE.AND.(C(I).LT.0.0)) CALL PGSLS(2) CALL PGCNSC(A,IDIM,JDIM,IA,IB,JA,JB,C(I),PLOT) IF (STYLE) CALL PGSLS(1) 40 CONTINUE 50 CONTINUE 60 CONTINUE C CALL PGSLS(LS) CALL PGEBUF END pgplot/src/grdtyp.f010064400040640000322000000036300621163570100150040ustar00tjpcitmbr00000400000017C*GRDTYP -- decode graphics device type string C+ INTEGER FUNCTION GRDTYP (TEXT) C C GRPCKG (internal routine): determine graphics device type code from C type name. It compares the argument with the table of known device C types in common. C C Argument: C C TEXT (input, character): device type name, eg 'PRINTRONIX'; the name C may be abbreviated to uniqueness. C C Returns: C C GRDTYP (integer): the device type code, in the range 1 to C GRTMAX, zero if the type name is not recognised, or -1 C if the type name is ambiguous. C-- C 27-Dec-1984 - rewrite so that is doesn't have to be modified for C new devices [TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 10-Nov-1995 - ignore drivers that report no device type [TJP]. C 30-Aug-1996 - check for an exact match; indicate if type is C ambiguous [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' CHARACTER*(*) TEXT INTEGER CODE, I, L, MATCH REAL RBUF(6) INTEGER NDEV,NBUF,LCHR INTEGER GRTRIM CHARACTER*32 CHR C GRDTYP = 0 L = GRTRIM(TEXT) IF (L.LT.1) RETURN MATCH = 0 CODE = 0 CALL GREXEC(0,0,RBUF,NBUF,CHR,LCHR) NDEV=NINT(RBUF(1)) DO 30 I=1,NDEV CALL GREXEC(I, 1,RBUF,NBUF,CHR,LCHR) IF (LCHR.GT.0) THEN IF(TEXT(1:L).EQ.CHR(1:L)) THEN IF (CHR(L+1:L+1).EQ.' ') THEN C -- exact match GRDTYP = I GRGTYP = GRDTYP RETURN ELSE MATCH = MATCH+1 CODE = I END IF END IF END IF 30 CONTINUE IF (MATCH.EQ.0) THEN C -- no match GRDTYP = 0 ELSE IF (MATCH.EQ.1) THEN GRDTYP = CODE GRGTYP = GRDTYP ELSE GRDTYP = -1 END IF C END pgplot/src/pgcn01.f010064400040640000322000000100540605574146400145730ustar00tjpcitmbr00000400000017 SUBROUTINE PGCN01(Z, MX, MY, IA, IB, JA, JB, Z0, PLOT, 1 FLAGS, IS, JS, SDIR) C C Support routine for PGCNSC. This routine draws a continuous contour, C starting at the specified point, until it either crosses the edge of C the array or closes on itself. C----------------------------------------------------------------------- INTEGER UP, DOWN, LEFT, RIGHT PARAMETER (UP=1, DOWN=2, LEFT=3, RIGHT=4) INTEGER MAXEMX, MAXEMY PARAMETER (MAXEMX=100, MAXEMY=100) LOGICAL FLAGS(MAXEMX,MAXEMY,2) INTEGER MX, MY, IA, IB, JA, JB, IS, JS, I, J, II, JJ, DIR, SDIR REAL Z(MX,*) REAL Z0, X, Y, STARTX, STARTY EXTERNAL PLOT C I = IS J = JS DIR = SDIR II = 1+I-IA JJ = 1+J-JA IF (DIR.EQ.UP .OR. DIR.EQ.DOWN) THEN X = REAL(I) + (Z0-Z(I,J))/(Z(I+1,J)-Z(I,J)) Y = REAL(J) ELSE X = REAL(I) Y = REAL(J) + (Z0-Z(I,J))/(Z(I,J+1)-Z(I,J)) END IF CD WRITE (*,*) 'SEGMENT' C C Move to start of contour and record starting point. C CALL PLOT(0, X, Y, Z0) STARTX = X STARTY = Y C C We have reached grid-point (I,J) going in direction DIR (UP, DOWN, C LEFT, or RIGHT). Look at the other three sides of the cell we are C entering to decide where to go next. It is important to look to the C two sides before looking straight ahead, in order to avoid self- C intersecting contours. If all 3 sides have unused crossing-points, C the cell is "degenerate" and we have to decide which of two possible C pairs of contour segments to draw; at present we make an arbitrary C choice. If we have reached the edge of the array, we have C finished drawing an unclosed contour. If none of the other three C sides of the cell have an unused crossing-point, we must have C completed a closed contour, which requires a final segment back to C the starting point. C 100 CONTINUE CD WRITE (*,*) I,J,DIR II = 1 + I - IA JJ = 1 + J - JA GOTO (110, 120, 130, 140), DIR C C DIR = UP C 110 CONTINUE FLAGS(II,JJ,1) = .FALSE. IF (J.EQ.JB) THEN RETURN ELSE IF (FLAGS(II,JJ,2)) THEN DIR = LEFT GOTO 200 ELSE IF (FLAGS(II+1,JJ,2)) THEN DIR = RIGHT I = I+1 GOTO 200 ELSE IF (FLAGS(II,JJ+1,1)) THEN C! DIR = UP J = J+1 GOTO 250 ELSE GOTO 300 END IF C C DIR = DOWN C 120 CONTINUE FLAGS(II,JJ,1) = .FALSE. IF (J.EQ.JA) THEN RETURN ELSE IF (FLAGS(II+1,JJ-1,2)) THEN DIR = RIGHT I = I+1 J = J-1 GOTO 200 ELSE IF (FLAGS(II,JJ-1,2)) THEN DIR = LEFT J = J-1 GOTO 200 ELSE IF (FLAGS(II,JJ-1,1)) THEN C! DIR = DOWN J = J-1 GOTO 250 ELSE GOTO 300 END IF C C DIR = LEFT C 130 CONTINUE FLAGS(II,JJ,2) = .FALSE. IF (I.EQ.IA) THEN RETURN ELSE IF (FLAGS(II-1,JJ,1)) THEN DIR = DOWN I = I-1 GOTO 250 ELSE IF (FLAGS(II-1,JJ+1,1)) THEN DIR = UP I = I-1 J = J+1 GOTO 250 ELSE IF (FLAGS(II-1,JJ,2)) THEN C! DIR = LEFT I = I-1 GOTO 200 ELSE GOTO 300 END IF C C DIR = RIGHT C 140 CONTINUE FLAGS(II,JJ,2) = .FALSE. IF (I.EQ.IB) THEN RETURN ELSE IF (FLAGS(II,JJ+1,1)) THEN DIR = UP J = J+1 GOTO 250 ELSE IF (FLAGS(II,JJ,1)) THEN DIR = DOWN GOTO 250 ELSE IF (FLAGS(II+1,JJ,2)) THEN C! DIR = RIGHT I = I+1 GOTO 200 ELSE GOTO 300 END IF C C Draw a segment of the contour. C 200 X = REAL(I) Y = REAL(J) + (Z0-Z(I,J))/(Z(I,J+1)-Z(I,J)) CALL PLOT(1,X,Y,Z0) GOTO 100 250 X = REAL(I) + (Z0-Z(I,J))/(Z(I+1,J)-Z(I,J)) Y = REAL(J) CALL PLOT(1,X,Y,Z0) GOTO 100 C C Close the contour and go look for another one. C 300 CALL PLOT(1,STARTX,STARTY,Z0) RETURN C END TEGER MX, MY, IA, IB, JA, JB, IS, JS, I, J, II, JJ, DIR, SDIR REAL Z(MX,*) REAL Z0, X, Y, STARTX, STARTY EXTERNAL PLOT C I = IS J = JS DIR = SDIR II = 1+I-IA JJ = 1+J-JA IF (DIR.EQ.UP .OR. DIR.EQ.DOWN) THEN X = REAL(I) + (Z0-Z(I,J))/(Z(I+1,J)-Z(I,J)) Y = REAL(J) ELSE X = REAL(I) Y = REAL(J) + (Z0-Z(I,J))/(Z(I,J+1)-Z(I,J)) END IF CD WRITE (*,*) 'SEGMENT' C Cpgplot/src/grrec0.f010064400040640000322000000056460606064660200146720ustar00tjpcitmbr00000400000017C*GRREC0 -- fill a rectangle (device coordinates) C+ SUBROUTINE GRREC0 (X0,Y0,X1,Y1) REAL X0, Y0, X1, Y1 C C GRPCKG: Fill a rectangle with solid color. The rectangle C is defined by the (x,y) device coordinates of its lower left and C upper right corners; the edges are parallel to the coordinate axes. C X0 is guaranteed to be <= X1 and Y0 <= Y1. The rectangle possible C extends beyond the clipping boundaries C C Arguments: C C X0, Y0 (input, real): device coordinates of one corner of the C rectangle. C X1, Y1 (input, real): device coordinates of the opposite corner of C the rectangle. C-- C 23-Mar-1988 - [TJP]. C 18-Jan-1991 - Code moved from GRRECT to GRREC0 so that it can also be C used by GRPXRE. C 1-Sep-1994 - suppress driver call [TJP]. C 4-Dec-1995 - avoid use of real variable as do-loop index [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER*32 CHR REAL XMIN, YMIN, XMAX, YMAX, Y, DY INTEGER LS, LW, I, NLINES C C Clip C XMIN = X0 XMAX = X1 YMIN = Y0 YMAX = Y1 IF (XMIN .LT. GRXMIN(GRCIDE)) XMIN = GRXMIN(GRCIDE) IF (XMAX .GT. GRXMAX(GRCIDE)) XMAX = GRXMAX(GRCIDE) IF (YMIN .LT. GRYMIN(GRCIDE)) YMIN = GRYMIN(GRCIDE) IF (YMAX .GT. GRYMAX(GRCIDE)) YMAX = GRYMAX(GRCIDE) IF (XMIN .GT. XMAX) RETURN IF (YMIN .GT. YMAX) RETURN C C Use hardware rectangle fill if available. C IF (GRGCAP(GRCIDE)(6:6).EQ.'R') THEN IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC RBUF(1) = XMIN RBUF(2) = YMIN RBUF(3) = XMAX RBUF(4) = YMAX CALL GREXEC(GRGTYP,24,RBUF,NBUF,CHR,LCHR) RETURN C C Else use hardware polygon fill if available. C ELSE IF (GRGCAP(GRCIDE)(4:4).EQ.'A') THEN IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC RBUF(1) = 4 CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) RBUF(1) = XMIN RBUF(2) = YMIN CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) RBUF(1) = XMAX RBUF(2) = YMIN CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) RBUF(1) = XMAX RBUF(2) = YMAX CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) RBUF(1) = XMIN RBUF(2) = YMAX CALL GREXEC(GRGTYP,20,RBUF,NBUF,CHR,LCHR) RETURN END IF C C For other devices fill area is simulated. C C Save attributes. C CALL GRQLS(LS) CALL GRQLW(LW) CALL GRSLS(1) CALL GRSLW(1) CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR) DY = RBUF(3) C C Draw horizontal raster lines. C NLINES = ABS((YMAX-YMIN)/DY) Y = YMIN - DY/2.0 DO 40 I=1,NLINES Y = Y + DY GRXPRE(GRCIDE) = XMIN GRYPRE(GRCIDE) = Y CALL GRLIN0(XMAX,Y) 40 CONTINUE C C Restore attributes. C CALL GRSLS(LS) CALL GRSLW(LW) END pgplot/src/grinit.f010064400040640000322000000010660614122562000147650ustar00tjpcitmbr00000400000017C*GRINIT -- initialize GRPCKG C+ SUBROUTINE GRINIT C C Initialize GRPCKG and read font file. Called by GROPEN, but may be C called explicitly if needed. C-- C 29-Apr-1996 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER I LOGICAL INIT SAVE INIT DATA INIT / .TRUE. / C IF (INIT) THEN DO 10 I=1,GRIMAX GRSTAT(I) = 0 10 CONTINUE CALL GRSY00 INIT = .FALSE. END IF RETURN END pgplot/src/pginit.f010064400040640000322000000011240614144731200147620ustar00tjpcitmbr00000400000017C PGINIT -- initialize PGPLOT (internal routine) C SUBROUTINE PGINIT C C Initialize PGPLOT. This routine should be called once during program C execution, before any other PGPLOT routines. C-- C Last modified: 1996 Apr 30 [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER CALLED, I SAVE CALLED DATA CALLED /0/ C IF (CALLED.EQ.0) THEN PGID = 0 DO 10 I=1,PGMAXD PGDEVS(I) = 0 10 CONTINUE CALL GRINIT CALLED = 1 END IF C RETURN END pgplot/src/grxrgb.f010064400040640000322000000040030624670767400150020ustar00tjpcitmbr00000400000017C*GRXRGB -- convert HLS color to RGB color C+ SUBROUTINE GRXRGB (H,L,S,R,G,B) C C GRPCKG: Convert a color specified in the HLS color model to one in C the RGB model. This is a support routine: no graphics I/O occurs. C The inverse transformation is accomplished with routine GRXHLS. C Reference: SIGGRAPH Status Report of the Graphic Standards Planning C Committee, Computer Graphics, Vol.13, No.3, Association for C Computing Machinery, New York, NY, 1979. C C Arguments: C C H,L,S (real, input): hue (0 to 360), lightness (0 to 1.0), and C saturation (0 to 1.0). C R,G,B (real, output): red, green, blue color coordinates, each in the C range 0.0 to 1.0. C-- C 2-Jul-1984 - new routine [TJP]. C 29-Sep-1994 - take H module 360 [TJP]. C 26-Nov-1996 - force results to be in range (avoid rounding error C problems on some machines) [TJP]. C----------------------------------------------------------------------- REAL H,L,S, R,G,B, MA, MI, HM C HM = MOD(H, 360.0) IF (HM.LT.0.0) HM = HM+360.0 IF (L.LE.0.5) THEN MA = L*(1.0+S) ELSE MA = L + S - L*S END IF MI = 2.0*L-MA C C R component C IF (HM.LT.60.0) THEN R = MI + (MA-MI)*HM/60.0 ELSE IF (HM.LT.180.0) THEN R = MA ELSE IF (HM.LT.240.0) THEN R = MI + (MA-MI)*(240.0-HM)/60.0 ELSE R = MI END IF C C G component C IF (HM.LT.120.0) THEN G = MI ELSE IF (HM.LT.180.0) THEN G = MI + (MA-MI)*(HM-120.0)/60.0 ELSE IF (HM.LT.300.0) THEN G = MA ELSE G = MI + (MA-MI)*(360.0-HM)/60.0 END IF C C B component C IF (HM.LT.60.0 .OR. HM.GE.300.0) THEN B = MA ELSE IF (HM.LT.120.0) THEN B = MI + (MA-MI)*(120.0-HM)/60.0 ELSE IF (HM.LT.240.0) THEN B = MI ELSE B = MI + (MA-MI)*(HM-240.0)/60.0 END IF C R = MIN(1.0, MAX(0.0,R)) G = MIN(1.0, MAX(0.0,G)) B = MIN(1.0, MAX(0.0,B)) C END RXRGB -- convert HLS color to RGB color C+ SUBROUTINE GRXRGB (H,L,S,R,G,B) C C GRPCKG: Convert a color specified in the HLS color model to one in C the RGB model. This is a support routine: no graphics I/O occurs. C The inverse transformation is accomplished with routine GRXHLS. C Reference: SIGGRAPH Status Report of the Graphic Standards Planning C Committee, Computer Graphics, Vol.13, No.3, Association for C Computing Machinery, New York, NY, 1979. C C Arguments: C C H,L,S (real, input): hue (0 pgplot/src/pgconl.f010064400040640000322000000073150627570166500147760ustar00tjpcitmbr00000400000017C*PGCONL -- label contour map of a 2D data array C%void cpgconl(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float c, const float *tr, const char *label, \ C% int intval, int minint); C+ SUBROUTINE PGCONL (A, IDIM, JDIM, I1, I2, J1, J2, C, TR, 1 LABEL, INTVAL, MININT) INTEGER IDIM, JDIM, I1, J1, I2, J2, INTVAL, MININT REAL A(IDIM,JDIM), C, TR(6) CHARACTER*(*) LABEL C C Label a contour map drawn with routine PGCONT. Routine PGCONT should C be called first to draw the contour lines, then this routine should be C called to add the labels. Labels are written at intervals along the C contour lines, centered on the contour lines with lettering aligned C in the up-hill direction. Labels are opaque, so a part of the under- C lying contour line is obscured by the label. Labels use the current C attributes (character height, line width, color index, character C font). C C The first 9 arguments are the same as those supplied to PGCONT, and C should normally be identical to those used with PGCONT. Note that C only one contour level can be specified; tolabel more contours, call C PGCONL for each level. C C The Label is supplied as a character string in argument LABEL. C C The spacing of labels along the contour is specified by parameters C INTVAL and MININT. The routine follows the contour through the C array, counting the number of cells that the contour crosses. The C first label will be written in the MININT'th cell, and additional C labels will be written every INTVAL cells thereafter. A contour C that crosses less than MININT cells will not be labelled. Some C experimentation may be needed to get satisfactory results; a good C place to start is INTVAL=20, MININT=10. C C Arguments: C A (input) : data array. C IDIM (input) : first dimension of A. C JDIM (input) : second dimension of A. C I1, I2 (input) : range of first index to be contoured (inclusive). C J1, J2 (input) : range of second index to be contoured (inclusive). C C (input) : the level of the contour to be labelled (one of the C values given to PGCONT). C TR (input) : array defining a transformation between the I,J C grid of the array and the world coordinates. C The world coordinates of the array point A(I,J) C are given by: C X = TR(1) + TR(2)*I + TR(3)*J C Y = TR(4) + TR(5)*I + TR(6)*J C Usually TR(3) and TR(5) are zero - unless the C coordinate transformation involves a rotation or C shear. C LABEL (input) : character strings to be used to label the specified C contour. Leading and trailing blank spaces are C ignored. C INTVAL (input) : spacing along the contour between labels, in C grid cells. C MININT (input) : contours that cross less than MININT cells C will not be labelled. C-- C 5-May-1994 - New routine; this routine is virtually identical to C PGCONT, but calls PGCONX with a different external C routine [TJP]. C 4-Feb-1997 - PGCONX requires an array argument, not scalar [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER I LOGICAL PGNOTO REAL CL(1) EXTERNAL PGCL C IF (PGNOTO('PGCONL')) RETURN C C Save TRANS matrix and other parameters. C DO 10 I=1,6 TRANS(I) = TR(I) 10 CONTINUE PGCINT = INTVAL PGCMIN = MININT PGCLAB = LABEL C C Use PGCONX with external function PGCL. C CL(1) = C CALL PGCONX (A, IDIM, JDIM, I1, I2, J1, J2, CL, 1, PGCL) C END pgplot/src/pgpage.f010064400040640000322000000071320627570215600147500ustar00tjpcitmbr00000400000017C*PGPAGE -- advance to new page C%void cpgpage(void); C+ SUBROUTINE PGPAGE C C Advance plotter to a new page or panel, clearing the screen if C necessary. If the "prompt state" is ON (see PGASK), confirmation is C requested from the user before clearing the screen. If the view C surface has been subdivided into panels with PGBEG or PGSUBP, then C PGPAGE advances to the next panel, and if the current panel is the C last on the page, PGPAGE clears the screen or starts a new sheet of C paper. PGPAGE does not change the PGPLOT window or the viewport C (in normalized device coordinates); but note that if the size of the C view-surface is changed externally (e.g., by a workstation window C manager) the size of the viewport is changed in proportion. C C Arguments: none C-- C 7-Feb-1983 C 23-Sep-1984 - correct bug: call GRTERM at end (if flush mode set). C 31-Jan-1985 - make closer to Fortran-77. C 19-Nov-1987 - explicitly clear the screen if device is interactive; C this restores the behavior obtained with older versions C of GRPCKG. C 9-Feb-1988 - move prompting into routine GRPROM. C 11-Apr-1989 - change name to PGPAGE. C 10-Sep-1990 - add identification labelling. C 11-Feb-1992 - check if device size has changed. C 3-Sep-1992 - allow column ordering of panels. C 17-Nov-1994 - move identification to drivers. C 23-Nov-1994 - fix bug: character size not getting reset. C 23-Jan-1995 - rescale viewport if size of view surface has changed. C 4-Feb-1997 - bug fix; character size was not correctly indexed by C device ID. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*16 STR LOGICAL INTER, PGNOTO REAL DUM1, DUM2, XS, YS, XVP1, XVP2, YVP1, YVP2 C IF (PGNOTO('PGPAGE')) RETURN C IF (PGROWS(PGID)) THEN PGNXC(PGID) = PGNXC(PGID) + 1 IF (PGNXC(PGID).GT.PGNX(PGID)) THEN PGNXC(PGID) = 1 PGNYC(PGID) = PGNYC(PGID) + 1 IF (PGNYC(PGID).GT.PGNY(PGID)) PGNYC(PGID) = 1 END IF ELSE PGNYC(PGID) = PGNYC(PGID) + 1 IF (PGNYC(PGID).GT.PGNY(PGID)) THEN PGNYC(PGID) = 1 PGNXC(PGID) = PGNXC(PGID) + 1 IF (PGNXC(PGID).GT.PGNX(PGID)) PGNXC(PGID) = 1 END IF END IF IF (PGNXC(PGID).EQ.1 .AND. PGNYC(PGID).EQ.1) THEN IF (PGADVS(PGID).EQ.1 .AND. PGPRMP(PGID)) THEN CALL GRTERM CALL GRPROM END IF CALL GRPAGE IF (.NOT.PGPFIX(PGID)) THEN C -- Get current viewport in NDC. CALL PGQVP(0, XVP1, XVP2, YVP1, YVP2) C -- Reset view surface size if it has changed CALL GRSIZE(PGID, XS,YS, DUM1,DUM2, 1 PGXPIN(PGID), PGYPIN(PGID)) PGXSZ(PGID) = XS/PGNX(PGID) PGYSZ(PGID) = YS/PGNY(PGID) C -- and character size CALL PGSCH(PGCHSZ(PGID)) C -- and viewport CALL PGSVP(XVP1, XVP2, YVP1, YVP2) END IF C C If the device is interactive, call GRBPIC to clear the page. C (If the device is not interactive, GRBPIC will be called C automatically before the first output; omitting the call here C ensures that a blank page is not output.) C CALL GRQTYP(STR,INTER) IF (INTER) CALL GRBPIC END IF PGXOFF(PGID) = PGXVP(PGID) + (PGNXC(PGID)-1)*PGXSZ(PGID) PGYOFF(PGID) = PGYVP(PGID) + 1 (PGNY(PGID)-PGNYC(PGID))*PGYSZ(PGID) C C Window the plot in the new viewport. C CALL PGVW PGADVS(PGID) = 1 CALL GRTERM END pgplot/src/grlin2.f010064400040640000322000000022550627615656600147140ustar00tjpcitmbr00000400000017C*GRLIN2 -- draw a normal line C+ SUBROUTINE GRLIN2 (X0,Y0,X1,Y1) C C GRPCKG : plot a visible line segment in absolute coords from C (X0,Y0) to (X1,Y1). The endpoints of the line segment are rounded C to the nearest integer and passed to the appropriate device-specific C routine. It is assumed that the entire line-segment lies within the C view surface, and that the physical device coordinates are C non-negative. C-- C (1-Jun-1984) C 19-Oct-1984 - rewritten for speed [TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 21-Feb-1987 - If needed, calls begin picture [AFT]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL X0,Y0,X1,Y1 REAL RBUF(6) INTEGER NBUF,LCHR CHARACTER CHR C C- If this is first thing plotted then set something plotted flag C- and for a GREXEC device call BEGIN_PICTURE. C IF (.NOT.GRPLTD(GRCIDE)) CALL GRBPIC C--- RBUF(1)=X0 RBUF(2)=Y0 RBUF(3)=X1 RBUF(4)=Y1 NBUF=4 C WRITE(*,'(A,4F10.5)') 'GRLIN2',RBUF(1), RBUF(2), RBUF(3), RBUF(4) CALL GREXEC(GRGTYP,12,RBUF,NBUF,CHR,LCHR) C END pgplot/src/grlina.f010064400040640000322000000011340627615660200147550ustar00tjpcitmbr00000400000017C*GRLINA -- draw a line (absolute, world coordinates) C+ SUBROUTINE GRLINA (X,Y) C C GRPCKG: draw line from current position to a specified position. C C Arguments: C C X, Y (real, input): world coordinates of the end-point of the line. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL X,Y C IF (GRCIDE.GE.1) THEN C WRITE (*,'(A,2F10.5)') 'GRLINA', X, Y CALL GRLIN0( X * GRXSCL(GRCIDE) + GRXORG(GRCIDE), 1 Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE) ) END IF END pgplot/src/grmova.f010064400040640000322000000011060627615661700150010ustar00tjpcitmbr00000400000017C*GRMOVA -- move pen (absolute, world coordinates) C+ SUBROUTINE GRMOVA (X,Y) C C GRPCKG: move the pen to a specified location. C C Arguments: C C X, Y (real, input): world coordinates of the new pen position. C-- C (1-Feb-1983) C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' REAL X,Y C IF (GRCIDE.GE.1) THEN C WRITE (*,'(A,2F10.5)') 'GRMOVA', X, Y GRXPRE(GRCIDE) = X * GRXSCL(GRCIDE) + GRXORG(GRCIDE) GRYPRE(GRCIDE) = Y * GRYSCL(GRCIDE) + GRYORG(GRCIDE) END IF END pgplot/src/pgsclp.f010064400040640000322000000020650630513437500147710ustar00tjpcitmbr00000400000017C*PGSCLP -- enable or disable clipping at edge of viewport C%void cpgsclp(int state); C+ SUBROUTINE PGSCLP(STATE) INTEGER STATE C C Normally all PGPLOT primitives except text are ``clipped'' at the C edge of the viewport: parts of the primitives that lie outside C the viewport are not drawn. If clipping is disabled by calling this C routine, primitives are visible wherever they lie on the view C surface. The default (clipping enabled) is appropriate for almost C all applications. C C Argument: C STATE (input) : 0 to disable clipping, or 1 to enable clipping. C C 25-Feb-1997 [TJP] - new routine. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO C IF (PGNOTO('PGSCLP')) RETURN C C Disable clipping. C IF (STATE.EQ.0) THEN CALL GRAREA(PGID,0.,0.,-1.,-1.) PGCLP(PGID) = 0 C C Enable clipping. C ELSE CALL GRAREA(PGID,PGXOFF(PGID),PGYOFF(PGID), : PGXLEN(PGID),PGYLEN(PGID)) PGCLP(PGID) = 1 END IF END pgplot/src/pgqvsz.f010064400040640000322000000044610630516724700150410ustar00tjpcitmbr00000400000017C*PGQVSZ -- inquire size of view surface C%void cpgqvsz(int units, float *x1, float *x2, float *y1, float *y2); C+ SUBROUTINE PGQVSZ (UNITS, X1, X2, Y1, Y2) INTEGER UNITS REAL X1, X2, Y1, Y2 C C This routine returns the dimensions of the view surface (the maximum C plottable area) of the currently selected graphics device, in C a variety of units. The size of the view surface is device-dependent C and is established when the graphics device is opened. On some C devices, it can be changed by calling PGPAP before starting a new C page with PGPAGE. On some devices, the size can be changed (e.g., C by a workstation window manager) outside PGPLOT, and PGPLOT detects C the change when PGPAGE is used. Call this routine after PGPAGE to C find the current size. C C Note 1: the width and the height of the view surface in normalized C device coordinates are both always equal to 1.0. C C Note 2: when the device is divided into panels (see PGSUBP), the C view surface is a single panel. C C Arguments: C UNITS (input) : 0,1,2,3 for output in normalized device coords, C inches, mm, or device units (pixels) C X1 (output) : always returns 0.0 C X2 (output) : width of view surface C Y1 (output) : always returns 0.0 C Y2 (output) : height of view surface C-- C 28-Aug-1992 - new routine [Neil Killeen]. C 2-Dec-1992 - changed to avoid resetting the viewport [TJP]. C 26-Feb-1997 - revised description [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO REAL SX, SY C IF (PGNOTO('PGQVSZ')) THEN X1 = 0.0 X2 = 0.0 Y1 = 0.0 Y2 = 0.0 RETURN END IF C IF (UNITS.EQ.0) THEN SX = PGXSZ(PGID) SY = PGYSZ(PGID) ELSE IF (UNITS.EQ.1) THEN SX = PGXPIN(PGID) SY = PGYPIN(PGID) ELSE IF (UNITS.EQ.2) THEN SX = (PGXPIN(PGID)/25.4) SY = (PGYPIN(PGID)/25.4) ELSE IF (UNITS.EQ.3) THEN SX = 1.0 SY = 1.0 ELSE CALL GRWARN( 1 'Illegal value for parameter UNITS in routine PGQVSZ') SX = PGXSZ(PGID) SY = PGYSZ(PGID) END IF X1 = 0.0 X2 = PGXSZ(PGID)/SX Y1 = 0.0 Y2 = PGYSZ(PGID)/SY END pgplot/src/pgpnts.f010064400040640000322000000037060630517074700150220ustar00tjpcitmbr00000400000017C*PGPNTS -- draw several graph markers, not all the same C%void cpgpnts(int n, const float *x, const float *y, \ C% const int *symbol, int ns); C+ SUBROUTINE PGPNTS (N, X, Y, SYMBOL, NS) INTEGER N, NS REAL X(*), Y(*) INTEGER SYMBOL(*) C C Draw Graph Markers. Unlike PGPT, this routine can draw a different C symbol at each point. The markers are drawn using the current values C of attributes color-index, line-width, and character-height C (character-font applies if the symbol number is >31). If the point C to be marked lies outside the window, no marker is drawn. The "pen C position" is changed to (XPTS(N),YPTS(N)) in world coordinates C (if N > 0). C C Arguments: C N (input) : number of points to mark. C X (input) : world x-coordinate of the points. C Y (input) : world y-coordinate of the points. C SYMBOL (input) : code number of the symbol to be plotted at each C point (see PGPT). C NS (input) : number of values in the SYMBOL array. If NS <= N, C then the first NS points are drawn using the value C of SYMBOL(I) at (X(I), Y(I)) and SYMBOL(1) for all C the values of (X(I), Y(I)) where I > NS. C C Note: the dimension of arrays X and Y must be greater than or equal C to N and the dimension of the array SYMBOL must be greater than or C equal to NS. If N is 1, X and Y may be scalars (constants or C variables). If NS is 1, then SYMBOL may be a scalar. If N is C less than 1, nothing is drawn. C-- C 11-Mar-1991 - new routine [JM]. C 26-Feb-1997 - revised to use PGPT1 [TJP]. C----------------------------------------------------------------------- INTEGER I, SYMB C IF (N.LT.1) RETURN CALL PGBBUF DO 10 I=1,N IF (I .LE. NS) THEN SYMB = SYMBOL(I) ELSE SYMB = SYMBOL(1) END IF CALL PGPT1(X(I), Y(I), SYMB) 10 CONTINUE CALL PGEBUF END pgplot/src/pgcirc.f010064400040640000322000000027400630517151400147440ustar00tjpcitmbr00000400000017C*PGCIRC -- draw a circle, using fill-area attributes C%void cpgcirc(float xcent, float ycent, float radius); C+ SUBROUTINE PGCIRC (XCENT, YCENT, RADIUS) REAL XCENT, YCENT, RADIUS C C Draw a circle. The action of this routine depends C on the setting of the Fill-Area Style attribute. If Fill-Area Style C is SOLID (the default), the interior of the circle is solid-filled C using the current Color Index. If Fill-Area Style is HOLLOW, the C outline of the circle is drawn using the current line attributes C (color index, line-style, and line-width). C C Arguments: C XCENT (input) : world x-coordinate of the center of the circle. C YCENT (input) : world y-coordinate of the center of the circle. C RADIUS (input) : radius of circle (world coordinates). C-- C 26-Nov-1992 - [TJP]. C 20-Sep-1994 - adjust number of points according to size [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER MAXPTS PARAMETER (MAXPTS=72) C INTEGER NPTS,I,RADPIX REAL ANGLE REAL X(MAXPTS),Y(MAXPTS) C RADPIX = NINT(RADIUS*MAX(PGXSCL(PGID), PGYSCL(PGID))) NPTS = MAX(8, MIN(MAXPTS, RADPIX)) DO 10 I=1,NPTS ANGLE = I*360.0/REAL(NPTS)/57.3 X(I) = XCENT + RADIUS*COS(ANGLE) Y(I) = YCENT + RADIUS*SIN(ANGLE) 10 CONTINUE CALL PGPOLY (NPTS,X,Y) C write (*,*) 'PGCIRC', NPTS C----------------------------------------------------------------------- END pgplot/src/pgpoly.f010064400040640000322000000077340630517161700150230ustar00tjpcitmbr00000400000017C*PGPOLY -- draw a polygon, using fill-area attributes C%void cpgpoly(int n, const float *xpts, const float *ypts); C+ SUBROUTINE PGPOLY (N, XPTS, YPTS) INTEGER N REAL XPTS(*), YPTS(*) C C Fill-area primitive routine: shade the interior of a closed C polygon in the current window. The action of this routine depends C on the setting of the Fill-Area Style attribute (see PGSFS). C The polygon is clipped at the edge of the C window. The pen position is changed to (XPTS(1),YPTS(1)) in world C coordinates (if N > 1). If the polygon is not convex, a point is C assumed to lie inside the polygon if a straight line drawn to C infinity intersects and odd number of the polygon's edges. C C Arguments: C N (input) : number of points defining the polygon; the C line consists of N straight-line segments, C joining points 1 to 2, 2 to 3,... N-1 to N, N to 1. C N should be greater than 2 (if it is 2 or less, C nothing will be drawn). C XPTS (input) : world x-coordinates of the vertices. C YPTS (input) : world y-coordinates of the vertices. C Note: the dimension of arrays XPTS and YPTS must be C greater than or equal to N. C-- C 21-Nov-1983 - [TJP]. C 16-Jul-1984 - revised to shade polygon with GRFA [TJP]. C 21-Oct-1985 - test PGFAS [TJP]. C 25-Nov-1994 - implement clipping [TJP]. C 13-Jan-1994 - fix bug in clipping [TJP]. C 6-Mar-1995 - add support for fill styles 3 and 4 [TJP]. C 12-Sep-1995 - fix another bug in clipping [TJP]. C----------------------------------------------------------------------- INTEGER MAXOUT PARAMETER (MAXOUT=1000) LOGICAL CLIP INTEGER I, N1, N2, N3, N4 REAL QX(MAXOUT), QY(MAXOUT), RX(MAXOUT), RY(MAXOUT) REAL XL, XH, YL, YH LOGICAL PGNOTO INCLUDE 'pgplot.inc' C IF (PGNOTO('PGPOLY')) RETURN IF (N.LT.1) RETURN C C Outline style, or polygon of less than 3 vertices. C IF (PGFAS(PGID).EQ.2 .OR. N.LT.3) THEN CALL PGBBUF CALL GRMOVA(XPTS(N),YPTS(N)) DO 10 I=1,N CALL GRLINA(XPTS(I),YPTS(I)) 10 CONTINUE C C Hatched style. C ELSE IF (PGFAS(PGID).EQ.3) THEN CALL PGBBUF CALL PGHTCH(N, XPTS, YPTS, 0.0) ELSE IF (PGFAS(PGID).EQ.4) THEN CALL PGBBUF CALL PGHTCH(N, XPTS, YPTS, 0.0) CALL PGHTCH(N, XPTS, YPTS, 90.0) ELSE C C Test whether polygon lies completely in the window. C CLIP = .FALSE. XL = MIN(PGXBLC(PGID),PGXTRC(PGID)) XH = MAX(PGXBLC(PGID),PGXTRC(PGID)) YL = MIN(PGYBLC(PGID),PGYTRC(PGID)) YH = MAX(PGYBLC(PGID),PGYTRC(PGID)) DO 20 I=1,N IF (XPTS(I).LT.XL .OR. XPTS(I).GT.XH .OR. : YPTS(I).LT.YL .OR. YPTS(I).GT.YH) THEN CLIP = .TRUE. GOTO 30 END IF 20 CONTINUE 30 CONTINUE C C Filled style, no clipping required. C CALL PGBBUF IF (.NOT.CLIP) THEN CALL GRFA(N,XPTS,YPTS) C C Filled style, clipping required: the vertices of the clipped C polygon are put in temporary arrays QX,QY, RX, RY. C ELSE CALL GRPOCL(N, XPTS, YPTS, 1, XL, MAXOUT, N1, QX, QY) IF (N1.GT.MAXOUT) GOTO 40 IF (N1.LT.3) GOTO 50 CALL GRPOCL(N1, QX, QY, 2, XH, MAXOUT, N2, RX, RY) IF (N2.GT.MAXOUT) GOTO 40 IF (N2.LT.3) GOTO 50 CALL GRPOCL(N2, RX, RY, 3, YL, MAXOUT, N3, QX, QY) IF (N3.GT.MAXOUT) GOTO 40 IF (N3.LT.3) GOTO 50 CALL GRPOCL(N3, QX, QY, 4, YH, MAXOUT, N4, RX, RY) IF (N4.GT.MAXOUT) GOTO 40 IF (N4.GT.0) CALL GRFA(N4,RX,RY) GOTO 50 40 CALL GRWARN('PGPOLY: polygon is too complex') 50 CONTINUE END IF END IF C C Set the current pen position. C CALL GRMOVA(XPTS(1),YPTS(1)) CALL PGEBUF C END pgplot/src/pgslct.f010064400040640000322000000017750630543073400150020ustar00tjpcitmbr00000400000017C*PGSLCT -- select an open graphics device C%void cpgslct(int id); C+ SUBROUTINE PGSLCT(ID) INTEGER ID C C Select one of the open graphics devices and direct subsequent C plotting to it. The argument is the device identifier returned by C PGOPEN when the device was opened. If the supplied argument is not a C valid identifier of an open graphics device, a warning message is C issued and the current selection is unchanged. C C [This routine was added to PGPLOT in Version 5.1.0.] C C Arguments: C C ID (input, integer): identifier of the device to be selected. C-- C 22-Dec-1995 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C IF (ID.LT.1 .OR. ID.GT.PGMAXD) THEN CALL GRWARN('PGSLCT: invalid argument') ELSE IF (PGDEVS(ID).NE.1) THEN CALL GRWARN('PGSLCT: requested device is not open') ELSE C -- Select the new device PGID = ID CALL GRSLCT(PGID) END IF C END pgplot/src/pgeras.f010064400040640000322000000014010630543124300147450ustar00tjpcitmbr00000400000017C*PGERAS -- erase all graphics from current page C%void cpgeras(void); C+ SUBROUTINE PGERAS C C Erase all graphics from the current page (or current panel, if C the view surface has been divided into panels with PGSUBP). C C Arguments: none C-- C 24-Jun-1994 C----------------------------------------------------------------------- INTEGER CI, FS REAL XV1, XV2, YV1, YV2, XW1, XW2, YW1, YW2 CALL PGBBUF CALL PGQCI(CI) CALL PGQFS(FS) CALL PGSCI(0) CALL PGSFS(1) CALL PGQWIN(XW1, XW2, YW1, YW2) CALL PGQVP(0, XV1, XV2, YV1, YV2) CALL PGSVP(0.0, 1.0, 0.0, 1.0) CALL PGRECT(XW1, XW2, YW1, YW2) CALL PGSVP(XV1, XV2, YV1, YV2) CALL PGSCI(CI) CALL PGSFS(FS) CALL PGEBUF END pgplot/src/pgask.f010064400040640000322000000017700630543140200145770ustar00tjpcitmbr00000400000017C*PGASK -- control new page prompting C%void cpgask(Logical flag); C+ SUBROUTINE PGASK (FLAG) LOGICAL FLAG C C Change the ``prompt state'' of PGPLOT. If the prompt state is C ON, PGPAGE will type ``Type RETURN for next page:'' and will wait C for the user to type a carriage-return before starting a new page. C The initial prompt state (after the device has been opened) is ON C for interactive devices. Prompt state is always OFF for C non-interactive devices. C C Arguments: C FLAG (input) : if .TRUE., and if the device is an interactive C device, the prompt state will be set to ON. If C .FALSE., the prompt state will be set to OFF. C-- C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' LOGICAL PGNOTO CHARACTER*1 TYPE C IF (PGNOTO('PGASK')) RETURN C IF (FLAG) THEN CALL GRQTYP(TYPE,PGPRMP(PGID)) ELSE PGPRMP(PGID) = .FALSE. END IF END pgplot/src/pgsah.f010064400040640000322000000021150630543413400145730ustar00tjpcitmbr00000400000017C*PGSAH -- set arrow-head style C%void cpgsah(int fs, float angle, float barb); C+ SUBROUTINE PGSAH (FS, ANGLE, BARB) INTEGER FS REAL ANGLE, BARB C C Set the style to be used for arrowheads drawn with routine PGARRO. C C Argument: C FS (input) : FS = 1 => filled; FS = 2 => outline. C Other values are treated as 2. Default 1. C ANGLE (input) : the acute angle of the arrow point, in degrees; C angles in the range 20.0 to 90.0 give reasonable C results. Default 45.0. C BARB (input) : the fraction of the triangular arrow-head that C is cut away from the back. 0.0 gives a triangular C wedge arrow-head; 1.0 gives an open >. Values 0.3 C to 0.7 give reasonable results. Default 0.3. C-- C 13-Oct-1992 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C PGAHS(PGID) = FS IF (PGAHS(PGID).NE.1) PGAHS(PGID) = 2 PGAHA(PGID) = ANGLE PGAHV(PGID) = BARB C END pgplot/src/pgqah.f010064400040640000322000000013320630543417500145760ustar00tjpcitmbr00000400000017C*PGQAH -- inquire arrow-head style C%void cpgqah(int *fs, float *angle, float *barb); C+ SUBROUTINE PGQAH (FS, ANGLE, BARB) INTEGER FS REAL ANGLE, BARB C C Query the style to be used for arrowheads drawn with routine PGARRO. C C Argument: C FS (output) : FS = 1 => filled; FS = 2 => outline. C ANGLE (output) : the acute angle of the arrow point, in degrees. C BARB (output) : the fraction of the triangular arrow-head that C is cut away from the back. C-- C 13-Oct-1992 - new routine [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' C FS = PGAHS(PGID) ANGLE = PGAHA(PGID) BARB = PGAHV(PGID) C END pgplot/src/grtext.f010064400040640000322000000131600634733342200150140ustar00tjpcitmbr00000400000017C*GRTEXT -- draw text C+ SUBROUTINE GRTEXT (CENTER,ORIENT,ABSXY,X0,Y0,STRING) C C GRPCKG: Write a text string using the high-quality character set. C The text is NOT windowed in the current viewport, but may extend over C the whole view surface. Line attributes (color, intensity thickness) C apply to text, but line-style is ignored. The current pen position C after a call to GRTEXT is undefined. C C Arguments: C C STRING (input, character): the character string to be plotted. This C may include standard escape-sequences to represent non-ASCII C characters and special commands. The number of characters in C STRING (i.e., LEN(STRING)) should not exceed 256. C-- C (3-May-1983) C 5-Aug-1986 - add GREXEC support [AFT]. C 6-Sep-1989 - standardize [TJP]. C 20-Apr-1995 - Verbose PS file support. If PGPLOT_PS_VERBOSE_TEXT is C defined, text strings in PS files are preceded by a C comment with the text of the string plotted as vectors C [TJP after D.S.Briggs]. C 4-Feb-1997 - grexec requires an RBUF array, not a scalar [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' LOGICAL ABSXY,UNUSED,VISBLE,CENTER INTEGER XYGRID(300) INTEGER LIST(256) CHARACTER*(*) STRING REAL ANGLE, FACTOR, FNTBAS, FNTFAC, COSA, SINA, DX, DY, XORG, YORG REAL XCUR, YCUR, ORIENT, RATIO, X0, Y0, RLX, RLY REAL XMIN, XMAX, YMIN, YMAX REAL RBUF(6) INTEGER I, IFNTLV,NLIST,LX,LY, K, LXLAST,LYLAST, LSTYLE INTEGER SLEN, GRTRIM INTRINSIC ABS, COS, LEN, MIN, SIN CHARACTER DEVTYP*14, STEMP*258 LOGICAL DEVINT, VTEXT C C Check that there is something to be plotted. C IF (LEN(STRING).LE.0) RETURN C C Check that a device is selected. C IF (GRCIDE.LT.1) THEN CALL GRWARN('GRTEXT - no graphics device is active.') RETURN END IF C C Save current line-style, and set style "normal". C CALL GRQLS(LSTYLE) CALL GRSLS(1) C C Put device dependent code here or at end C VTEXT = .FALSE. CALL GRQTYP (DEVTYP, DEVINT) IF ((DEVTYP.EQ.'PS').OR.(DEVTYP.EQ.'VPS').OR. 1 (DEVTYP.EQ.'CPS').OR.(DEVTYP.EQ.'VCPS')) THEN CALL GRGENV ('PS_VERBOSE_TEXT', STEMP, I) VTEXT = (I.GT.0) IF (VTEXT) THEN SLEN = GRTRIM(STRING) STEMP = '% Start "' // STRING(1:SLEN) // '"' CALL GREXEC (GRGTYP, 23, RBUF, 0, STEMP, SLEN+10) END IF END IF C C Save current viewport, and open the viewport to include the full C view surface. C XORG = GRXPRE(GRCIDE) YORG = GRYPRE(GRCIDE) XMIN = GRXMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMIN = GRYMIN(GRCIDE) YMAX = GRYMAX(GRCIDE) CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0) C C Compute scaling and orientation. C ANGLE = ORIENT*(3.14159265359/180.) FACTOR = GRCFAC(GRCIDE)/2.5 RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE) COSA = FACTOR * COS(ANGLE) SINA = FACTOR * SIN(ANGLE) CALL GRTXY0(ABSXY, X0, Y0, XORG, YORG) FNTBAS = 0.0 FNTFAC = 1.0 IFNTLV = 0 DX = 0.0 DY = 0.0 C C Convert the string to a list of symbol numbers; to prevent overflow C of array LIST, the length of STRING is limited to 256 characters. C CALL GRSYDS(LIST,NLIST,STRING(1:MIN(256,LEN(STRING))), 1 GRCFNT(GRCIDE)) C C Plot the string of characters C DO 380 I = 1,NLIST IF (LIST(I).LT.0) THEN IF (LIST(I).EQ.-1) THEN C ! up IFNTLV = IFNTLV+1 FNTBAS = FNTBAS + 16.0*FNTFAC FNTFAC = 0.75**ABS(IFNTLV) ELSE IF (LIST(I).EQ.-2) THEN C ! down IFNTLV = IFNTLV-1 FNTFAC = 0.75**ABS(IFNTLV) FNTBAS = FNTBAS - 16.0*FNTFAC ELSE IF (LIST(I).EQ.-3) THEN C ! backspace XORG = XORG - DX*FNTFAC YORG = YORG - DY*FNTFAC END IF GOTO 380 END IF CALL GRSYXD(LIST(I),XYGRID,UNUSED) VISBLE = .FALSE. LX = XYGRID(5)-XYGRID(4) DX = COSA*LX*RATIO DY = SINA*LX K = 4 LXLAST = -64 LYLAST = -64 320 K = K+2 LX = XYGRID(K) LY = XYGRID(K+1) IF (LY.EQ.-64) GOTO 330 IF (LX.EQ.-64) THEN VISBLE = .FALSE. ELSE RLX = (LX - XYGRID(4))*FNTFAC RLY = (LY - XYGRID(2))*FNTFAC + FNTBAS IF ((LX.NE.LXLAST) .OR. (LY.NE.LYLAST)) THEN XCUR = XORG + (COSA*RLX - SINA*RLY)*RATIO YCUR = YORG + (SINA*RLX + COSA*RLY) IF (VISBLE) THEN CALL GRLIN0(XCUR,YCUR) ELSE GRXPRE(GRCIDE) = XCUR GRYPRE(GRCIDE) = YCUR END IF END IF VISBLE = .TRUE. LXLAST = LX LYLAST = LY END IF GOTO 320 330 XORG = XORG + DX*FNTFAC YORG = YORG + DY*FNTFAC 380 CONTINUE C C Set pen position ready for next character. C GRXPRE(GRCIDE) = XORG GRYPRE(GRCIDE) = YORG C C Another possible device dependent section C IF (VTEXT) THEN STEMP = '% End "' // STRING(1:SLEN) // '"' CALL GREXEC(GRGTYP, 23, RBUF, 0, STEMP, SLEN+8) END IF C C Restore the viewport and line-style, and return. C GRXMIN(GRCIDE) = XMIN GRXMAX(GRCIDE) = XMAX GRYMIN(GRCIDE) = YMIN GRYMAX(GRCIDE) = YMAX CALL GRSLS(LSTYLE) C END PRE(GRCIDE) XMIN = GRXMIN(GRCIDE) XMAX = GRXMAX(GRCIDE) YMIN = GRYMIN(GRCIDE) YMAX = GRYMAX(GRCIDE) CALL GRAREA(GRCIDE, 0.0, 0.0, 0.0, 0.0) C C Compute scaling and orientation. C ANGLE = ORIENT*(3.14159265359/180.) FACTOR = GRCFAC(GRCIDE)/2.5 RATIO = GRPXPI(GRCIDE)/GRPYPI(GRCIDE) COSA = FACTOR * COS(ANGLE) SINA = FACTOR * SIN(ANGLE) pgplot/sys_dos/aaaread.me010064400040640000322000000166550573663572100161510ustar00tjpcitmbr00000400000017The following notes are reproduced from an earlier version of PGPLOT. PGPLOT v5.0 has not yet been ported to MS-DOS. Neither I nor Allyn Tennant has the resources to do this. Anyone planning to try to port PGPLOT to MS-DOS should contact me before doing so, to avoid duplication of effort. The makefile in this directory is not complete, but may serve as a model. Tim Pearson 30 December 1994 ------------------------------------------------------------------------ PGPLOT on an MS-DOS machine Allyn F. Tennant Marshall Space Flight Center 1991-Jun-30 This this directory contains all the files needed to get PGPLOT to compile with Microsoft Fortran 5.0 (or later) using the huge memory model. Earlier versions of Microsoft Fortran do not support the INCLUDE statement, and also do not come with the GRAPHICS library. The current code was tested on a 286 machine with a floating point co-processor and an EGA display. The code should support other configurations. If you are using another Fortran compiler then it is unlikely that you will be able to directly use the files in this directory. However, the files included here will give you some idea of what you will need to port. Writing a new device handler is the only thing that might be difficult. There are many books that provide routines for drawing lines on an IBM PC screen that can be included in a device handler. For example, see the routines in "Programmer's Guide to the EGA/VGA" by George Sutty and Steve Blair (Simon & Schuster, 1988). It is a simple matter to write a device handler that uses these routines. Due to copyright these routines cannot be provided. GETTING THE FILES TO THE MS-DOS MACHINE There are two ways to get PGPLOT on to an MS-DOS machine. First, you can use KERMIT (or your favorite file transfer method) to copy the various directories from a UNIX machine to the DOS machine. If you do this you should try to preserve the directory structure from a UNIX system, thus files from pgplot/sys_dos should be placed in PGPLOT\SYS_DOS. The second method involves using the AIX access package from IBM. We have a IBM RS/6000 machine and AIX Access allows us to mount the IBM disks on the DOS machine. With this method it is not necessary to move any files. UNIX terminates lines with a linefeed character whereas DOS uses the double character sequence return/linefeed. Much DOS software cannot cope with the UNIX record structure, however, the Microsoft Fortran seems to be able to compile files where the lines terminate with only a linefeed character. Should you need to convert two AIX routines are provided for file conversion. The routine 2aix will strip any extra return characters, effectively converting the file to UNIX format. Likewise 2dos will append a return character to every line the file converting to DOS format. Note, do not worry about the file extensions. The current version of MAKEFILE.DOS can cope with either *.F (typical UNIX) or *.FOR (needed by DOS). The makefile works by copying the *.F file into an *.FOR file, compiling, and then deleting the *.FOR file. TESTED DRIVERS Currently only the following drivers have been tested under MS-DOS: /NULL to plot onto the null device. /MSOFT to use the Microsoft graphics library routines to plot onto supported graphics displays. This driver has only been tested with an EGA display but should work with other types. Currently, the cursor is not supported. /PS to produce a file that can be printed on a Postscript printer. /VPS to produce a 'vertical' or portrait mode Postscript file. BUILDING THE LIBRARY The directory PGPLOT\SYS_DOS contains the source code for GRSY00.FOR contains the name and path of the font file. The default location for the font file is given by: PARAMETER (UNIX='C:\lib\grfont.dat') If you do not like that location, then you should modify this file to contain the location where you will keep the font file. The environment variable PGPLOT_FONT can be used to override this location at run time. If PGPLOT cannot find the font file, then plots will still be drawn, but without labels or markers. If you are using AIX Access, then on the IBM side you should copy pgadvance.f to pgadvanc.f. This is because the NMAKE file includes this file and (of course) DOS only allows 8 letter file names. Next, copy the file MAKEFILE.DOS from PGPLOT\SYS_DOS to the PGPLOT directory. Then in that directory type: NMAKE -F MAKEFILE.DOS NMAKE -F MAKEFILE.DOS and go out to lunch (actually on a 286 using AIX Access it takes about 2 hours for the above to complete). About half way through the execution of the first NMAKE, DOS announces that it cannot load FL. I think the problem is DOS runs out of memory keeping track of what has already been made. Starting over seems to free up enough memory so that NMAKE should complete. If you are low on memory, then I would not be surprised if NMAKE fails to finish on the second try. All I can say is keep trying (or better yet trade in your DOS machine for a real computer). PGPLOT ENVIRONMENT VARIABLES As mentioned above, you can override the location of the FONT library at run time by setting an environment variable. For example, SET PGPLOT_FONT=C:\LIB would cause PGPLOT to look in the C:\LIB directory for the GRFONT.DAT file. MS-DOS does not support user-ids, and therefore if you want a user-id to appear on your plots when PGIDEN is used, then you should define the environment variable PGPLOT_USER. For example, I include the following line SET PGPLOT_USER=TENNANT in my AUTOEXEC.BAT file. TRY THE DEMO PROGRAMS Currently PGDEMO3.EXE will link but not run. It is too big to fit into the 8088 address space that DOS uses. However, all the other PGDEMOx and PGEXxx programs should run. Note, if you are using the /MSOFT device, then the PC will be left in graphics mode. This allows the graph to remain after the program exits. If you would like to return to text mode, you should use a command like: MODE CO80 LINKING WITH THE PGPLOT LIBRARY You will notice that the MAKEFILE compiles the code with the /Gt option. The Microsoft Fortran compiler default is to place all variables and arrays greater than 32K into a common segment. At link time, the sum of all these common areas (one for each subroutine) cannot exceed 64K (I believe the error is L1072, but have forgotten). When this problem occurs, the only solution is to re-compile enough routines with a smaller threshold value (and for a package consisting of over 100 routines, this could be a lot of routines). Using /Gt (with no number) reduces the threshold size to 256 bytes. (Actually to be extra safe, you should trade in your machine for a computer that has never heard of 64K segments). The linker always looks in the directory specified by the LIB environment variable. If you copy PGPLOT to that directory then the following command line should work: LINK /SEGMENTS:256 prog.obj,,NUL,PGPLOT+GRAPHICS; where object is the name of the object module(s) that you have previously complied. GRAPHICS is the name of the Microsoft graphics library supplied with Fortran 5.0 and is required if you wish to use the Microsoft device handler (MSDRIV.FOR). With the huge memory model, each subroutine is compiled into a separate segment. A complicated program can easily contain calls to more than 128 routines (the default maximum number of segments). Therefore you are encouraged to use the /SEGMENTS:256 to increase this default. on a 286 machine with a floating point co-processor and an EGA display. The code pgplot/sys_dos/lhdriv.f010064400040640000322000000212700537422362400156650ustar00tjpcitmbr00000400000017C*LHDRIV -- PGPLOT device driver for MS-DOS machines running Lahey F77 C 32-bit FORTRAN C+ SUBROUTINE LHDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for IBM PC's and clones running Lahey F77 32-bit Fortran v5.0. C This driver will put the display into graphics mode, and calls to 'close' C the workstation will set it back into the previous mode (generally erasing C the display, so don't do it until you are really finished). C C This routine must be compiled and linked with the Lahey graphics C library GRAPH3 supplied with Lahey Fortran v4.0 or greater. C C Microsoft FORTRAN versions: C 1989-Nov-03 - Started work [AFT] C 1989-Apr-06 - Improved version [AFT] C 1991-Mar-13 - Added cursor routine [JHT] C Lahey FORTRAN versions: C 1991-Dec-28 - derived from Microsoft version [PAH] C----------------------------------------------------------------------- C C Supported device: IBM PC's and compatables C C Device type code: /LH C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Depends on monitor, typical 7x10 inches C C Resolution: Depends on graphics card. Tested with a 640x480 VGA card. C Driver should work with other graphics cards, however, expect to C tweak it a bit. C C Color capability: Color indices 0-15 are accepted. This version maps C the PGPLOT color indices into the IBM color indices for with the C default color most closely corresponds to the PGPLOT default color. C Thus, PGPLOT index 2 (red) maps to IBM index 12 (light red). C C Input capability: Graphics cursor implemented using Microsoft Mouse C or compatible, accessed through DOS calls. C C File format: None. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- CHARACTER CMSG*10 REAL A,B real xfac, yfac parameter (xfac=11.0/640.0, yfac=8.5/480.0) integer pencolour, pend, colourmap(0:15), ix, iy logical got_mouse save pencolour, pend DATA colourmap/ 0,15,12,10, 9,11,13,14, 6, 2, 3, 1, 5, 4, 8, 7/ C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260) IFUNC 900 WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in LAHEY device driver: '/ : /CMSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = 'LH' LCHR = 2 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE RBUF(1) = 0 RBUF(2) = 640.0 RBUF(3) = 0 RBUF(4) = 480.0 RBUF(5) = 0 RBUF(6) = 15.0 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. C 30 continue A = 640.0/9.5 RBUF(1) = A B = 480.0/7.5 RBUF(2) = B RBUF(3) = 1.0 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, No cursor, No dashed lines, No area fill, C No thick lines, No rectangle fill, No pixel primitives,) C 40 continue if (got_mouse()) then CHR = 'ICNNNNNNNN' else CHR = 'INNNNNNNNN' endif LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = ' ' LCHR = 1 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE RBUF(1) = 0 RBUF(2) = 640.0 RBUF(3) = 0 RBUF(4) = 480.0 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE RBUF(1) = 0 RBUF(2) = 1 NBUF = 2 IF(RBUF(3) .NE. 0.0) THEN PEND=1 ELSE PEND=0 END IF CALL PLOTS(0, 0, 18) RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE CALL PLOT(0, 0, 999) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF(PEND.EQ.0) THEN CALL PLOT(0, 0, -999) ENDIF PEND=0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE CALL PLOT(RBUF(1)*xfac, RBUF(2)*yfac, 3) CALL PLOT(RBUF(3)*xfac, RBUF(4)*yfac, 2) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE CALL SETPIX(RBUF(1)*xfac, RBUF(2)*yfac, pencolour) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE IF (RBUF(1) .NE. 0.0) THEN CALL PLOT(0.0, 0.0, -999) ENDIF RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 CONTINUE pencolour=MIN( MAX(0,NINT(RBUF(1))) ,15) pencolour=colourmap(pencolour) CALL NEWPEN(pencolour) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C C 170 CONTINUE ix = nint(rbuf(1)) iy = 479-nint(rbuf(2)) call show_mouse call put_mouse(ix,iy) call cursor_key(ix,iy,chr) rbuf(1) = ix rbuf(2) = 479-iy call hide_mouse RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE RETURN C C--- IFUNC=25, Set fill pattern. --------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels. ----------------------------------------- C 260 CONTINUE RETURN C----------------------------------------------------------------------- END logical function got_mouse() implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 0 ntrup = 51 call intrup(intary,ntrup) got_mouse = (eax .eq. 65535) return end subroutine show_mouse implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 1 ntrup = 51 call intrup(intary,ntrup) return end subroutine hide_mouse implicit none integer*2 ntrup integer intary(9), eax equivalence (eax,intary(1)) eax = 2 ntrup = 51 call intrup(intary,ntrup) return end subroutine get_mouse(ix, iy, button) implicit none integer ix, iy, button integer*2 ntrup integer intary(9), eax integer*2 bx, cx, dx equivalence (eax,intary(1)), - (bx,intary(2)), - (cx,intary(3)), - (dx,intary(4)) eax = 3 ntrup = 51 call intrup(intary,ntrup) ix = cx iy = dx button = bx return end subroutine put_mouse(ix, iy) implicit none integer ix, iy integer*2 ntrup integer intary(9), eax integer*2 bx, cx, dx equivalence (eax,intary(1)), - (bx,intary(2)), - (cx,intary(3)), - (dx,intary(4)) eax = 4 cx = ix dx = iy ntrup = 51 call intrup(intary, ntrup) return end subroutine cursor_key(ix, iy, key) implicit none character*(*) key integer ix, iy, ikey, ib integer*2 ixkey ikey = ixkey() key = char(ikey) call get_mouse(ix, iy, ib) return end C, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for IBM PC's and clones running Lahey F77 32-bit Fortran v5.0. C This driver will put the display into graphics mode, and calls to 'close' C the workstation will set it back into the previous mode (generally erasing C the display, so don't do it untipgplot/sys_dos/grexec.f010064400040640000322000000017370567074526700156730ustar00tjpcitmbr00000400000017C*GREXEC -- PGPLOT device handler dispatch routine C+ SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IDEV, IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C DO NOT MODIFY THIS ROUTINE. C You should always create a new version by re-executing C the command file NEWEXEC.COM. C--- INTEGER NDEV PARAMETER (NDEV=6) CHARACTER*10 MSG C--- GOTO(1,2,3,4,5,6) IDEV IF (IDEV.EQ.0) THEN RBUF(1) = NDEV NBUF = 1 ELSE WRITE (MSG,'(I10)') IDEV CALL GRQUIT('Unknown device code in GREXEC: '//MSG) END IF RETURN C--- 1 CALL NUDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN 2 CALL MSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN 3 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) RETURN 4 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) RETURN 5 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,3) RETURN 6 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,4) RETURN C END pgplot/sys_dos/makefile.dos010064400040640000322000000326460670241275400165230ustar00tjpcitmbr00000400000017# Makefile for PGPLOT use with Microsoft Fortran AFT 91-Jun-27 # # This generates the PGPLOT binary files (libraries and demos) in the # current default directory (which need not be the source directory). # # Directory containing PGPLOT source code PGTOP=\pgplot SRCDIR=$(PGTOP)\src # Directory containing demo programs DEMODIR=$(PGTOP)\examples # Directory containing device drivers DRIVDIR=$(PGTOP)\DRIVERS # Directory containing font stuff FONTDIR=$(PGTOP)\fonts # Directory containing system-dependent code SYSDIR=$(PGTOP)\sys_dos # Directory to put the libraries LIBDIR=. # Fortran compiler FCOMPL=FL FFLAGC=/Gt /FPc # C compiler CCOMPL= CFLAGC= # Libraries required for linking LIBS = .\PGPLOT+GRAPHICS # Rules for compiling Fortran .SUFFIXES: .F .OBJ {$(SRCDIR)}.F.OBJ: COPY $(SRCDIR)\$*.F $*.FOR $(FCOMPL) /c $(FFLAGC) $*.FOR DEL $*.FOR {$(DRIVDIR)}.F.OBJ: COPY $(DRIVDIR)\$*.F $*.FOR $(FCOMPL) /c $(FFLAGC) $*.FOR DEL $*.FOR {$(SYSDIR)}.F.OBJ: COPY $(SYSDIR)\$*.F $*.FOR $(FCOMPL) /c $(FFLAGC) $*.FOR DEL $*.FOR all: PGPLOT.LIB GRFONT.DAT PROG #----------------------------------------------------------------------- # Routine lists: # PG_ROUTINES: basic PGPLOT routines (Fortran-77) # PG_NON_STANDARD: non-Fortran-77 aliases for basic routines # GR_ROUTINES: support routines, not called directly by applications # (Fortran-77) # SYSTEM_ROUTINES: potentially non-portable routines, usually # operating-system dependent #----------------------------------------------------------------------- PGPLOT.LIB:: pgplot.inc grpckg1.inc REM PGPLOT.LIB:: pgask.obj pgarro.obj pgband.obj pgbbuf.obj pgbeg.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgbin.obj pgbox.obj pgbox1.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgcirc.obj pgcl.obj pgclos.obj pgcn01.obj pgcnsc.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgconb.obj pgconl.obj pgcons.obj pgcont.obj pgconx.obj pgcp.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgctab.obj pgcurs.obj pgdraw.obj pgebuf.obj pgend.obj pgenv.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgeras.obj pgerrb.obj pgerrx.obj pgerry.obj pgetxt.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgfunt.obj pgfunx.obj pgfuny.obj pggray.obj pghi2d.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pghis1.obj pghist.obj pghtch.obj pgiden.obj pgimag.obj pginit.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pglab.obj pglcur.obj pgldev.obj pglen.obj pgline.obj pgmove.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgmtxt.obj pgncur.obj pgnoto.obj pgnpl.obj pgnumb.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgolin.obj pgopen.obj pgpage.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgpap.obj pgpixl.obj pgpnts.obj pgpoly.obj pgpt.obj pgptxt.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgqah.obj pgqcf.obj pgqch.obj pgqci.obj pgqcir.obj pgqcol.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgqcr.obj pgqcs.obj pgqfs.obj pgqhs.obj pgqinf.obj pgqls.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgqlw.obj pgqpos.obj pgqtbg.obj pgqtxt.obj pgqvp.obj pgqvsz.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgqwin.obj pgrect.obj pgrnd.obj pgrnge.obj pgsah.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgsave.obj pgscf.obj pgsch.obj pgsci.obj pgslct.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgscr.obj pgscrn.obj pgsfs.obj pgshls.obj pgshs.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgsls.obj pgslw.obj pgstbg.obj pgsubp.obj pgsvp.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgswin.obj pgtbox.obj pgtext.obj pgupdt.obj pgvect.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgvsiz.obj pgvstd.obj pgvw.obj pgwedg.obj pgwnad.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grdot1.obj pgconf.obj pgerr1.obj pgpt1.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgqclp.obj pgqdt.obj pgqndt.obj pgsclp.obj pgtikl.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgadvanc.obj pgbegin.obj pgcurse.obj pglabel.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgmtext.obj pgncurse.obj pgpaper.obj pgpoint.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgptext.obj pgvport.obj pgvsize.obj pgvstand.obj LIB PGPLOT -+$?; PGPLOT.LIB:: pgwindow.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grarea.obj grbpic.obj grchsz.obj grclip.obj grclos.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grclpl.obj grctoi.obj grcurs.obj grdot0.obj grdtyp.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grepic.obj gresc.obj gretxt.obj grfa.obj grfao.obj grgfil.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grgray.obj grimg0.obj grimg1.obj grimg2.obj grimg3.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grinit.obj grldev.obj grlen.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grlin0.obj grlin1.obj grlin2.obj grlin3.obj grlina.obj LIB PGPLOT -+$?; PGPLOT.LIB::grmcur.obj grmker.obj grmova.obj grmsg.obj LIB PGPLOT -+$?; PGPLOT.LIB:: gropen.obj grpage.obj grpars.obj grpixl.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grpocl.obj grprom.obj grpxps.obj grqcap.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grqci.obj grqcr.obj grqdev.obj grqdt.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grqfnt.obj grqcol.obj grqls.obj grqlw.obj grqpos.obj grqtyp.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grqdev.obj grqtxt.obj grquit.obj grrect.obj grscr.obj grskpb.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grslct.obj grsetc.obj grsci.obj grsfnt.obj grsls.obj grslw.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grsets.obj grsize.obj grsyds.obj grsymk.obj grsyxd.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grterm.obj grtext.obj grtoup.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grtrim.obj grtrn0.obj grtxy0.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grvct0.obj grwarn.obj grxhls.obj grxrgb.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grpxpo.obj grpxpx.obj grpxre.obj grrec0.obj gritoc.obj LIB PGPLOT -+$?; # These files come from sys_dos directory PGPLOT.LIB:: grexec.obj msdriv.obj grdate.obj grflun.obj grgcom.obj LIB PGPLOT -+$?; PGPLOT.LIB:: grgenv.obj grglun.obj groptx.obj grtrml.obj grtter.obj gruser.obj LIB PGPLOT -+$?; # These files are found in pgplot\sys PGPLOT.LIB:: grlgtr.obj grsy00.obj LIB PGPLOT -+$?; grlgtr.obj: $(PGTOP)\sys\grlgtr.f COPY $(PGTOP)\sys\grlgtr.F grlgtr.FOR $(FCOMPL) /c $(FFLAGC) grlgtr.FOR DEL grlgtr.FOR grsy00.obj: $(PGTOP)\sys\grsy00.f COPY $(PGTOP)\sys\grsy00.F grsy00.FOR $(FCOMPL) /c $(FFLAGC) grsy00.FOR DEL grsy00.FOR #----------------------------------------------------------------------- # Device drivers #----------------------------------------------------------------------- LJDRIVER=ljdriv.obj grlj00.obj LLDRIVER=lldriv.obj grlj00.obj NUDRIVER=nudriv.obj PSDRIVER=psdriv.obj QMDRIVER=qmdriv.obj grqm00.obj QPDRIVER=qpdriv.obj grqm00.obj # Compile drivers that compile under Microsoft Fortran. # Not all these drivers have actually been tested. PGPLOT.LIB:: $(NUDRIVER) LIB PGPLOT -+$(NUDRIVER); PGPLOT.LIB:: $(PSDRIVER) LIB PGPLOT -+$(PSDRIVER); # # Note that if you want to build a sharable library including these routines, # specifically grdat2.o, you will have to add grdat2.o to the DATAOBJS list. # OBSOLETE_ROUTINES=\ grchar.obj grchr0.obj grdat2.obj grgtc0.obj grmark.obj grinqli.obj\ grinqpen.obj\ grsetli.obj grsetpen.obj grlinr.obj grmovr.obj grtran.obj grvect.obj\ pgsetc.obj pgsize.obj grinqfon.obj grsetfon.obj #----------------------------------------------------------------------- # Target "lib" is used to built the PGPLOT subroutiune library. # libpgplot.a is the primary PGPLOT library. #----------------------------------------------------------------------- lib : PGPLOT.LIB #----------------------------------------------------------------------- # libpgobs.a contains obsolete routines used by some programs #----------------------------------------------------------------------- PGOBS.LIB : $(OBSOLETE_ROUTINES) LIB PGOBS -+$?; #----------------------------------------------------------------------- # Target "prog" is used to make the demo programs. They can also be made # individually. #----------------------------------------------------------------------- # List of demo programs DEMOS = pgdemo1.exe pgdemo2.exe pgdemo3.exe pgdemo4.exe pgdemo5.exe \ pgdemo6.exe pgdemo7.exe pgdemo8.exe pgdemo9.exe pgdemo10.exe \ pgdemo11.exe pgdemo12.exe pgdemo13.exe pgdemo14.exe pgdemo15.exe \ pgdemo16.exe pgdemo17.exe prog: $(DEMOS) pgdemo1.exe: $(DEMODIR)\pgdemo1.f COPY $(DEMODIR)\pgdemo1.f pgdemo1.for $(FCOMPL) /c $(FFLAGC) pgdemo1.FOR LINK /SEGMENTS:256 pgdemo1.obj,,NUL,$(LIBS); DEL pgdemo1.for pgdemo2.exe: $(DEMODIR)\pgdemo2.f COPY $(DEMODIR)\pgdemo2.f pgdemo2.for $(FCOMPL) /c $(FFLAGC) pgdemo2.FOR LINK /SEGMENTS:256 pgdemo2.obj,,NUL,$(LIBS); DEL pgdemo2.for pgdemo3.exe: $(DEMODIR)\pgdemo3.f COPY $(DEMODIR)\pgdemo3.f pgdemo3.for $(FCOMPL) /c $(FFLAGC) pgdemo3.FOR LINK /SEGMENTS:256 pgdemo3.obj,,NUL,$(LIBS); DEL pgdemo3.for pgdemo4.exe: $(DEMODIR)\pgdemo4.f COPY $(DEMODIR)\pgdemo4.f pgdemo4.for $(FCOMPL) /c $(FFLAGC) pgdemo4.FOR LINK /SEGMENTS:256 pgdemo4.obj,,NUL,$(LIBS); DEL pgdemo4.for pgdemo5.exe: $(DEMODIR)\pgdemo5.f COPY $(DEMODIR)\pgdemo5.f pgdemo5.for $(FCOMPL) /c $(FFLAGC) pgdemo5.FOR LINK /SEGMENTS:256 pgdemo5.obj,,NUL,$(LIBS); DEL pgdemo5.for pgdemo6.exe: $(DEMODIR)\pgdemo6.f COPY $(DEMODIR)\pgdemo6.f pgdemo6.for $(FCOMPL) /c $(FFLAGC) pgdemo6.FOR LINK /SEGMENTS:256 pgdemo6.obj,,NUL,$(LIBS); DEL pgdemo6.for pgdemo7.exe: $(DEMODIR)\pgdemo7.f COPY $(DEMODIR)\pgdemo7.f pgdemo7.for $(FCOMPL) /c $(FFLAGC) pgdemo7.FOR LINK /SEGMENTS:256 pgdemo7.obj,,NUL,$(LIBS); DEL pgdemo7.for pgdemo8.exe: $(DEMODIR)\pgdemo8.f COPY $(DEMODIR)\pgdemo8.f pgdemo8.for $(FCOMPL) /c $(FFLAGC) pgdemo8.FOR LINK /SEGMENTS:256 pgdemo8.obj,,NUL,$(LIBS); DEL pgdemo8.for pgdemo9.exe: $(DEMODIR)\pgdemo9.f COPY $(DEMODIR)\pgdemo9.f pgdemo9.for $(FCOMPL) /c $(FFLAGC) pgdemo9.FOR LINK /SEGMENTS:256 pgdemo9.obj,,NUL,$(LIBS); DEL pgdemo9.for pgdemo10.exe: $(DEMODIR)\pgdemo10.f COPY $(DEMODIR)\pgdemo10.f pgdemo10.for $(FCOMPL) /c $(FFLAGC) pgdemo10.FOR LINK /SEGMENTS:256 pgdemo10.obj,,NUL,$(LIBS); DEL pgdemo10.for pgdemo11.exe: $(DEMODIR)\pgdemo11.f COPY $(DEMODIR)\pgdemo11.f pgdemo11.for $(FCOMPL) /c $(FFLAGC) pgdemo11.FOR LINK /SEGMENTS:256 pgdemo11.obj,,NUL,$(LIBS); DEL pgdemo11.for pgdemo12.exe: $(DEMODIR)\pgdemo12.f COPY $(DEMODIR)\pgdemo12.f pgdemo12.for $(FCOMPL) /c $(FFLAGC) pgdemo12.FOR LINK /SEGMENTS:256 pgdemo12.obj,,NUL,$(LIBS); DEL pgdemo12.for pgdemo13.exe: $(DEMODIR)\pgdemo13.f COPY $(DEMODIR)\pgdemo13.f pgdemo13.for $(FCOMPL) /c $(FFLAGC) pgdemo13.FOR LINK /SEGMENTS:256 pgdemo13.obj,,NUL,$(LIBS); DEL pgdemo13.for pgdemo14.exe: $(DEMODIR)\pgdemo14.f COPY $(DEMODIR)\pgdemo14.f pgdemo14.for $(FCOMPL) /c $(FFLAGC) pgdemo14.FOR LINK /SEGMENTS:256 pgdemo14.obj,,NUL,$(LIBS); DEL pgdemo14.for pgdemo15.exe: $(DEMODIR)\pgdemo15.f COPY $(DEMODIR)\pgdemo15.f pgdemo15.for $(FCOMPL) /c $(FFLAGC) pgdemo15.FOR LINK /SEGMENTS:256 pgdemo15.obj,,NUL,$(LIBS); DEL pgdemo15.for pgdemo16.exe: $(DEMODIR)\pgdemo16.f COPY $(DEMODIR)\pgdemo16.f pgdemo16.for $(FCOMPL) /c $(FFLAGC) pgdemo16.FOR LINK /SEGMENTS:256 pgdemo16.obj,,NUL,$(LIBS); DEL pgdemo16.for pgdemo17.exe: $(DEMODIR)\pgdemo17.f COPY $(DEMODIR)\pgdemo17.f pgdemo17.for $(FCOMPL) /c $(FFLAGC) pgdemo17.FOR LINK /SEGMENTS:256 pgdemo17.obj,,NUL,$(LIBS); DEL pgdemo17.for #----------------------------------------------------------------------- # Target "grfont.dat" is the binary font file. # This is created from grfont.txt with the "pgpack" program. # (a) compile the `pgpack' program; then # (b) run `pgpack' to convert the ASCII version of the font file # (grfont.txt) into the binary version (grfont.dat). When executed, # `pgpack' should report: # Characters defined: 996 # Array cells used: 26732 #----------------------------------------------------------------------- pgpack.exe: $(FONTDIR)\pgpack.f COPY $(FONTDIR)\pgpack.F pgpack.FOR $(FCOMPL) $(FFLAGC) pgpack.FOR DEL pgpack.FOR grfont.dat: $(FONTDIR)\grfont.txt pgpack.exe DEL grfont.dat pgpack <$(FONTDIR)\grfont.txt #----------------------------------------------------------------------- # Target "install" is required for Figaro. #----------------------------------------------------------------------- install: #----------------------------------------------------------------------- # Target "clean" is used to remove all the intermediate files. #----------------------------------------------------------------------- clean : DEL *.OBJ DEL *.FOR DEL PGPLOT.BAK DEL PGPACK.EXE DEL PGPLOT.INC DEL GRPCKG1.INC SPOTLESS: CLEAN DEL *.EXE DEL GRFONT.DAT DEL PGPLOT.LIB # Include file dependencies: # The following PG routines reference `pgplot.inc' grgray.o \ pgask.o pgbbuf.o pgbeg.o pgbin.o pgbox.o pgcont.o pgcp.o \ pgcurs.o pgebuf.o pgend.o pgerrb.o pgerrx.o pgerry.o pggray.o pghi2d.o \ pghist.o pgiden.o pglcur.o pglen.o pgmtxt.o pgncur.o pgolin.o \ pgpage.o pgpap.o pgpixl.o pgpoly.o pgpt.o pgptxt.o pgqch.o pgqfs.o \ pgqinf.o pgqvp.o pgqwin.o pgrect.o pgsch.o pgsfs.o pgsvp.o \ pgswin.o pgupdt.o pgvsiz.o pgvstd.o pgvw.o pgwnad.o: $(SRC)/pgplot.inc # The following GR routines reference `grpckg.inc' grarea.o grbpic.o grchr0.o grchsz.o grclos.o grclpl.o grcurs.o \ grdot0.o grdtyp.o gresc.o gretxt.o grfa.o grgray.o grgrgr.o \ grldev.o grlen.o grlin0.o grlin1.o grlin2.o grlin3.o \ grlina.o grlinr.o grmker.o grmova.o grmovr.o gropen.o grpage.o \ grpixl.o grpxpo.o grpxpx.o \ grqci.o grqcol.o grqdev.o grqdt.o grqfnt.o grqls.o \ grqlw.o grqpos.o grqtyp.o grrec0.o grrect.o \ grsci.o grscr.o grsetc.o grsetli.o grsets.o grsfnt.o grsize.o \ grslct.o grsls.o grslw.o grterm.o grtext.o grtrn0.o grtxy0.o \ grvct0.o: $(SRCDIR)/grpckg1.inc pgplot.inc: $(SRCDIR)\pgplot.inc COPY $(SRCDIR)\pgplot.inc . grpckg1.inc: $(SRCDIR)\grpckg1.inc COPY $(SRCDIR)\grpckg1.inc . -------------------------------------------------------- # Device drivers #-------------pgplot/sys_dos/msdriv.f010064400040640000322000000375160600730561000157010ustar00tjpcitmbr00000400000017 INCLUDE 'FGRAPH.FI' C*MSDRIV -- PGPLOT device driver for MS-DOS machines C+ SUBROUTINE MSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR INCLUDE 'FGRAPH.FD' C C PGPLOT driver for IBM PC's and clones running Microsoft Fortran 5.0. C This driver will put the display into graphics mode. To avoid 'erasing' C the screen when the program exits, the display will be left in graphics C mode. Therefore, you will need some other program to restore to the C display to a (faster) text mode. C C This routine must be compiled and linked with the Microsoft graphics C library supplied with Microsoft Fortran 5.0 or greater. C C LINK QDP,,NUL,\XANADU\PLOT\PGPLOT\PGPLOT+\FOR\LIB\GRAPHICS; C C where \XANADU\PLOT\PGPLOT\PGPLOT.LIB is the name of the PGPLOT library C containing the PGPLOT code and \FOR\LIB\GRAPHICS.LIB is the graphics C library supplied with Microsoft Fortran 5.0. *********** C--- The call to the adapter type gives the HIGHEST resoltion, and C--- within those the higest number of colors. C--- The list is based on Fortran 5.1 manual advanced topics, table 13.5 C--- The selection for the Olivetti has not been tested. C--- C--- It was noted that the calls to MICROSOFT FORTRAN V5.1 RGB colors were C--- were made as INTEGER*2. This gave too few colors for redefined palettes. C--- The correct decleration is INTEGER*4. *********** C C 1989-Nov-03 - Started work [AFT] C 1989-Apr-06 - Improved version [AFT] C 1991-Mar-13 - Added cursor routine [JHT] C 1994-Mar-30 - Improved the search for the optimum graphics card. [HJL] C 1994-Jun-08 - Fixed bug in definition of RGB color variables. [HJL] C 1994-Dec-03 - Added PC9801 NEC mode [YK] C 1995-Jul-31 - concatnated YK and HJL versions [HJL] C----------------------------------------------------------------------- C C Supported device: IBM PC's and compatibles C C Device type code: /MSOFT C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Depends on monitor, typical 7x10 inches C C Resolution: Depends on graphics card. Tested with a 640x300 EGA card. C Driver should work with other graphics cards, however, expect to C tweak it a bit. C C Color capability: Color indices 0-15 are accepted. This version maps C the PGPLOT color indices into the IBM color indices for with the C default color most closely corresponds to the PGPLOT default color. C Thus, PGPLOT index 2 (red) maps to IBM index 12 (light red). C C Input capability: None. C C File format: None. C C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- RECORD /VIDEOCONFIG/ VID RECORD /XYCOORD/ XY C CHARACTER CMSG*10 INTEGER LEVEL, MXX, MXY REAL A,B INTEGER*4 I2TAB(0:15) INTEGER*4 I2BLU, I2GRN, I2IND, I2PEND, I2RED INTEGER*4 I2STAT, I2TMP INTEGER*2 I2X0, I2Y0, I2X1, I2Y1 LOGICAL QFIRST SAVE QFIRST, MXX, MXY DATA I2TAB/ 0,15,12,10, 9,11,13,14, 6, 2, 3, 1, 5, 4, 8, 7/ DATA QFIRST/.TRUE./ C C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260) IFUNC 900 WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in MSOFT device driver: '/ : /CMSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = 'MSOFT' LCHR = 5 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0 RBUF(2) = FLOAT(MXX) RBUF(3) = 0 RBUF(4) = FLOAT(MXY) RBUF(5) = 0 RBUF(6) = 15 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. C 30 continue IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) A = FLOAT(MXX)/10.0 RBUF(1) = A B = FLOAT(MXY)/7.0 RBUF(2) = B RBUF(3) = 1.0 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, cursor, No dashed lines, No area fill, C No thick lines, No rectangle fill) C 40 CHR = 'ICNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = ' ' LCHR = 1 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0 RBUF(2) = FLOAT(MXX) RBUF(3) = 0 RBUF(4) = FLOAT(MXY) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0 RBUF(2) = 1 NBUF = 2 IF(RBUF(3).NE.0.) THEN I2PEND=1 ELSE I2PEND=0 END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE C I2STAT = SETVIDEOMODE( $DEFAULTMODE ) RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) IF(I2PEND.EQ.0) THEN CALL CLEARSCREEN($GCLEARSCREEN) END IF I2PEND=0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I2X0=NINT(RBUF(1)) I2Y0=MXY-NINT(RBUF(2)) CALL MOVETO(I2X0, I2Y0, XY) I2X1=NINT(RBUF(3)) I2Y1=MXY-NINT(RBUF(4)) I2STAT=LINETO(I2X1, I2Y1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I2X0=NINT(RBUF(1)) I2Y0=MXY-NINT(RBUF(2)) I2STAT=SETPIXEL(I2X0, I2Y0) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 CONTINUE I2TMP=MIN( MAX(0,NINT(RBUF(1))) ,15) I2IND=I2TAB(I2TMP) I2STAT=SETCOLOR(I2IND) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C C 170 CONTINUE I2X0 = NINT(RBUF(1)) I2Y0 = MXY-NINT(RBUF(2)) CALL GRMS01( I2X0, I2Y0, CHR, VID) RBUF(1) = FLOAT(I2X0) RBUF(2) = FLOAT(MXY-I2Y0) NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE I2TMP=MIN( MAX(0,NINT(RBUF(1))), 15) I2IND=I2TAB(I2TMP) IF(VID.NUMCOLORS.EQ.16) THEN C EGA 16 color mode I2RED=INT(RBUF(2)*3.999) I2GRN=INT(RBUF(3)*3.999) I2BLU=INT(RBUF(4)*3.999) LEVEL=(#303030.AND.(ISHFT(I2BLU,20).OR.ISHFT(I2GRN,12).OR. : ISHFT(I2RED,4))) I2STAT=REMAPPALETTE(I2IND,LEVEL) ELSE IF(VID.NUMCOLORS.EQ.256) THEN C VGA 256 color mode I2RED=INT(RBUF(2)*63.999) I2GRN=INT(RBUF(3)*63.999) I2BLU=INT(RBUF(4)*63.999) LEVEL=(#3F3F3F.AND.(ISHFT(I2BLU,16).OR.ISHFT(I2GRN,8).OR. : I2RED)) I2STAT=REMAPPALETTE(I2IND,LEVEL) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE RETURN C C--- IFUNC=25, Set fill pattern. --------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels. ----------------------------------------- C 260 CONTINUE RETURN C----------------------------------------------------------------------- END C********* SUBROUTINE GRMS00(VID, MXX, MXY, QFIRST) INCLUDE 'FGRAPH.FD' RECORD /VIDEOCONFIG/ VID INTEGER MXX, MXY ,TR$L LOGICAL QFIRST C--- INTEGER*2 I2STAT C added parameter override of default configuration... JHT 23-Feb-1991 C C changed defaults to select the more sensible option maximum resolution. C left in the over ride for compatibility with previous version. C Option can be overridden by setting an enviroment variable PG_VIDEO C to MAXCOL. Other options are MAXRES,VGA16,VGA2, EGA15, EGA4 etc. C HJL 30-Mar-1994 character*128 TR$VID C--- QFIRST=.FALSE. CALL GRGENV('VIDEO', TR$VID, TR$L) IF (TR$L.EQ.0. OR. + (TR$L.NE.0. AND. TR$VID(:TR$L).EQ.'MAXRES')) THEN CALL GETVIDEOCONFIG(VID) IF(VID.ADAPTER.EQ.$VGA .OR. VID.ADAPTER.EQ.$OVGA)THEN I2STAT=SETVIDEOMODE($VRES16COLOR) ELSE IF(VID.ADAPTER.EQ.$MCGA) THEN I2STAT=SETVIDEOMODE($VRES2COLOR) ELSE IF(VID.ADAPTER.EQ.$EGA) THEN IF(VID.MONITOR .EQ. $MONO) THEN I2STAT=SETVIDEOMODE($ERESNOCOLOR) ELSE I2STAT=SETVIDEOMODE($ERESCOLOR) END IF ELSE IF(VID.ADAPTER.EQ.$OEGA) THEN I2STAT=SETVIDEOMODE($ORESCOLOR) ELSE IF(VID.ADAPTER.EQ.$CGA) THEN I2STAT=SETVIDEOMODE($HRESBW) ELSE IF(VID.ADAPTER.EQ.$OCGA) THEN I2STAT=SETVIDEOMODE($ORESCOLOR) ELSE IF(VID.ADAPTER.EQ.$HGC) THEN I2STAT=SETVIDEOMODE($HERCMONO) ELSE IF(VID.ADAPTER.EQ.$98CGA .or. VID.ADAPTER.EQ.$98EGA) THEN I2STAT=SETVIDEOMODE($MAXRESMODE) two lines above are added for PC9801 NEC compatibles ELSE WRITE(*,*) 'Unknown graphics adapter.' STOP END IF ELSE IF(TR$VID(:TR$L) .EQ. 'EGA16') THEN I2STAT=SETVIDEOMODE($ERESCOLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'VGA16') THEN I2STAT=SETVIDEOMODE($VRES16COLOR) ELSE CALL GETVIDEOCONFIG(VID) IF(VID.ADAPTER.EQ.$VGA .OR. VID.ADAPTER.EQ.$OVGA. OR. + VID.ADAPTER.EQ.$MCGA) THEN I2STAT=SETVIDEOMODE($MRES256COLOR) ELSE IF(VID.ADAPTER.EQ.$EGA) THEN IF(VID.MONITOR .EQ. $MONO) THEN I2STAT=SETVIDEOMODE($ERESNOCOLOR) ELSE IF(VID.NUMCOLORS.EQ.256) THEN I2STAT=SETVIDEOMODE($ERESCOLOR) ELSE I2STAT=SETVIDEOMODE($HRES16COLOR) END IF END IF ELSE IF(VID.ADAPTER.EQ.$OEGA) THEN I2STAT=SETVIDEOMODE($ERESCOLOR) ELSE IF(VID.ADAPTER.EQ.$CGA) THEN IF(VID.MONITOR.EQ.$MONO) THEN I2STAT=SETVIDEOMODE($MRESNOCOLOR) ELSE I2STAT=SETVIDEOMODE($MRES4COLOR) END IF ELSE IF(VID.ADAPTER.EQ.$OCGA) THEN I2STAT=SETVIDEOMODE($MRES4COLOR) ELSE IF(VID.ADAPTER.EQ.$HGC) THEN I2STAT=SETVIDEOMODE($HERCMONO) ELSE IF(VID.ADAPTER.EQ.$98CGA .or. VID.ADAPTER.EQ.$98EGA) THEN I2STAT=SETVIDEOMODE($MAXRESMODE) c two lines above are added for PC9801 NEC compatibles ELSE WRITE(*,*) 'Unknown graphics adapter.' STOP END IF END IF END IF CALL GETVIDEOCONFIG(VID) MXX=VID.NUMXPIXELS-1 MXY=VID.NUMYPIXELS-1 RETURN END C********* SUBROUTINE GRMS01( IX, IY, CHR, VID) INCLUDE 'FGRAPH.FD' RECORD /xycoord/ XY RECORD /VIDEOCONFIG/ VID INTEGER*4 IMSIZE,INC,CNT(2),IHR,IMIN,ISEC,ITICK INTEGER*2 IX, IY, X0, Y0, X1, Y1, IERR, DUMMY INTEGER*2 ACTION INTEGER*1 SCAN INTEGER*1 BUFFER[ALLOCATABLE] (:) CHARACTER*(*) CHR INTEGER*1 ICHR DATA ACTION/ $GPSET / C OVERKILL ON IMAGESIZE IN CASE THERE ARE BYTE ALLIGNMENT ISSUES IMSIZE = IMAGESIZE( 0,0,25,25 ) C C COUNTER AND INCREMENT TO ADD CURSOR ACCELLERATION CNT(1) = 0 INC = 1 ALLOCATE( BUFFER( IMSIZE ), STAT = IERR ) IF( IERR .NE. 0 ) THEN DUMMY = SETVIDEOMODE( $DEFAULTMODE ) STOP 'Error: insufficient memory' ENDIF ICHR = 0 DO WHILE(ICHR .EQ. 0) IX = MAX0( IX, 0) IY = MAX0( IY, 0) IX = MIN0( IX, (VID.NUMXPIXELS - 1)) C IY = MIN0( IY, (VID.NUMYPIXELS - 1)) C X0 = MAX0( (IX - 10), 0 ) Y0 = MAX0( (IY - 10), 0 ) X1 = MIN0( (IX + 10), (VID.NUMXPIXELS - 1)) Y1 = MIN0( (IY + 10), (VID.NUMYPIXELS - 1)) C SAVE IMAGE BELOW WHERE CURSOR WILL BE CALL GETIMAGE( X0, Y0, X1, Y1, BUFFER ) C NOW DRAW CURSOR CALL MOVETO( X0, IY, XY) DUMMY = LINETO( X1, IY) CALL MOVETO( IX, Y0, XY) DUMMY = LINETO( IX, Y1) CALL GETCH(ICHR,SCAN) C RESTORE IMAGE CALL PUTIMAGE( X0, Y0, BUFFER, ACTION ) C CALCULATE TIME PAST AND ACCELERATE IF NECESSARY CALL GETTIM(IHR,IMIN,ISEC,ITICK) CNT(2) = ITICK + 100*ISEC + 6000*IMIN IF ((CNT(2)-CNT(1)) .LT. 25) THEN INC = MIN0((INC + 1),30) CNT(1) = CNT(2) ELSE INC = 1 CNT(1) = CNT(2) ENDIF IF(SCAN .EQ. #48) THEN IY = IY - INC ELSE IF (SCAN .EQ. #50) THEN IY = IY + INC ELSE IF(SCAN .EQ. #4D) THEN IX = IX + INC ELSE IF(SCAN .EQ. #4B) THEN IX = IX - INC ENDIF ENDDO DEALLOCATE( BUFFER ) CHR = ICHR RETURN END C--- C These functions are discussed in Chapter 3 of the Advanced Topics C manual. The program DEMOEXEC.FOR illustrates how to use the include C file and the functions. C Function: INTDOS C C Purpose: calls dos interrupt C C Argument: STRUCTURE - REGISTERS C STRUCTURE - RETURNED REGISTERS C C Return: INTEGER*2 - ax REGISTER C C Example: dummy2 = INTDOS(INREG,OUTREG) C C INTERFACE TO FUNCTION INTDOS [C] (INREG,OUTREG) INTEGER*2 INTDOS STRUCTURE/REGS/ INTEGER*2 AX INTEGER*2 BX INTEGER*2 CX INTEGER*2 DX INTEGER*2 SI INTEGER*2 DI INTEGER*2 CFLAG END STRUCTURE RECORD/REGS/INREG [REFERENCE] RECORD/REGS/OUTREG [REFERENCE] END CC DEMOEXEC.FOR - Demonstration program for calling C system and CC spawnp library functions. These functions are included in the CC FORTRAN library. They are discussed in Chapter 3 of the Advanced CC Topics manual. CC CC To compile and link DEMOEXEC.FOR type the command: CC CC FL DEMOEXEC.FOR SUBROUTINE GETCH(CHR,SCAN) INTEGER*1 CHR,SCAN C C C Declare return types C INTEGER*2 INTDOS STRUCTURE/REGS/ INTEGER*1 AL, AH INTEGER*1 BL, BH INTEGER*1 CL, CH INTEGER*1 DL, DH INTEGER*1 SIL, SIH INTEGER*1 DIL, DIH INTEGER*1 CFL,CFH END STRUCTURE RECORD/REGS/INREGS RECORD/REGS/OUTREGS C CHR= 0 SCAN = 0 INREGS.AH=#08 INREGS.AL=0 I = INTDOS( INREGS , OUTREGS ) CHR = OUTREGS.AL IF(CHR .EQ. 0) THEN I = INTDOS( INREGS , OUTREGS ) SCAN = OUTREGS.AL ENDIF C write(*,'(1x,z2)') OUTREGS.AL END =NINT(RBUF(1)) I2Y0=MXY-NINT(RBUF(2)) CALL MOVETO(I2X0, I2Y0, XY) I2X1=NINT(RBUF(3)) I2Y1=MXY-NINT(RBUF(4)) I2STAT=LINETO(I2X1, I2Y1) RETURN Cpgplot/sys_dos/grdate.f010064400040640000322000000021270573663462400156530ustar00tjpcitmbr00000400000017C*GRDATE -- get date and time as character string (MS-DOS) C+ SUBROUTINE GRDATE(CDATE, LDATE) CHARACTER CDATE*(17) INTEGER LDATE C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the CDATE should be declared C CHARACTER*17. C C Arguments: C CDATE : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 1989-Mar-17 - [AFT] C----------------------------------------------------------------------- CHARACTER CMON(12)*3 INTEGER*2 IHR, IMIN, ISEC, I100TH INTEGER*2 IYR, IMON, IDAY DATA CMON/'Jan','Feb','Mar','Apr','May','Jun', : 'Jul','Aug','Sep','Oct','Nov','Dec'/ C--- CALL GETTIM(IHR, IMIN, ISEC, I100TH) CALL GETDAT(IYR, IMON, IDAY) WRITE(CDATE,111) IDAY,CMON(IMON),IYR,IHR,IMIN 111 FORMAT(I2,'-',A3,'-',I4,' ',I2,':',I2) LDATE=17 RETURN END pgplot/sys_dos/grflun.f010064400040640000322000000007010573663462400156760ustar00tjpcitmbr00000400000017 C*GRFLUN -- free a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. [This version C is pretty stupid; GRGLUN allocates units starting at 81, and GRFLUN C does not free units.] C C Arguments: C LUN : the logical unit number to free. C-- C 25-Nov-1988 C----------------------------------------------------------------------- RETURN END pgplot/sys_dos/grgcom.f010064400040640000322000000016740573663462400156710ustar00tjpcitmbr00000400000017 C*GRGCOM -- read with prompt from user's terminal (MS-DOS) C+ INTEGER FUNCTION GRGCOM(CREAD, CPROM, LREAD) CHARACTER CREAD*(*), CPROM*(*) INTEGER LREAD C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C CREAD : (output) receives the string read from the terminal. C CPROM : (input) prompt string. C LREAD : (output) length of CREAD. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 1989-Mar-29 C----------------------------------------------------------------------- INTEGER IER C--- 11 FORMAT(A) C--- GRGCOM = 0 LREAD = 0 WRITE (*, 101, IOSTAT=IER) CPROM 101 FORMAT(1X,A,$) IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CREAD IF (IER.EQ.0) GRGCOM = 1 LREAD = LEN(CREAD) 10 IF (CREAD(LREAD:LREAD).NE.' ') GOTO 20 LREAD = LREAD-1 GOTO 10 20 CONTINUE END pgplot/sys_dos/grgenv.f010064400040640000322000000033630573663553700157040ustar00tjpcitmbr00000400000017C********* INTERFACE TO CHARACTER FUNCTION GETENV [C] + (CBUF[REFERENCE]) C--- C Allow MS-Fortran to call the GETENV function built into the C Fortran 5.0 library. C--- CHARACTER*1 CBUF END C********* C*GRGENV -- get value of PGPLOT environment parameter (MS-DOS) C+ SUBROUTINE GRGENV(CNAME, CVALUE, LVALUE) CHARACTER CNAME*(*), CVALUE*(*) INTEGER LVALUE C C Return the value of a PGPLOT environment parameter. C C Arguments: C CNAME : (input) the name of the parameter to evaluate. C CVALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C LVALUE : receives the number of characters in CVALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 1990-Mar-19 - [AFT] C----------------------------------------------------------------------- CHARACTER GETENV*64 C CHARACTER CTMP*64 INTEGER I, LTMP C CTMP = 'PGPLOT_'//CNAME LTMP = INDEX(CTMP,' ') IF(LTMP.EQ.0) LTMP=LEN(CTMP)-1 CTMP(LTMP:LTMP)=CHAR(0) CTMP=GETENV(CTMP(:LTMP)) CVALUE = ' ' LVALUE = 0 C--- C MS-Fortran Kludge, if the environment variable is undefined, then C GETENV points to NULL (memory location zero). I see no easy way to C detect this condition in Fortran, therefore, I compare with an C environment variable that noone would ever define and hence should C always point at NULL. IF(GETENV('#$%^'//CHAR(0)).EQ.CTMP) GOTO 140 DO 130 I=1,LEN(CTMP) IF(CTMP(I:I).EQ.CHAR(0)) GOTO 140 LVALUE=LVALUE+1 CVALUE(LVALUE:LVALUE)=CTMP(I:I) 130 CONTINUE 140 CONTINUE RETURN END pgplot/sys_dos/grglun.f010064400040640000322000000017570573663462500157140ustar00tjpcitmbr00000400000017 C*GRGLUN -- get a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Get an unused Fortran logical unit number. C Returns a Logical Unit Number that is not currently opened. C After GRGLUN is called, the unit should be opened to reserve C the unit number for future calls. Once a unit is closed, it C becomes free and another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 C as older software will often use these units without warning. C C Arguments: C LUN : receives the logical unit number, or -1 on error. C-- C 12-Feb-1989 [AFT/TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL QOPEN C--- DO 10 I=99,10,-1 INQUIRE (UNIT=I, OPENED=QOPEN) IF (.NOT.QOPEN) THEN LUN = I RETURN END IF 10 CONTINUE CALL GRWARN('GRGLUN: out of units.') LUN = -1 RETURN END pgplot/sys_dos/grgmsg.f010064400040640000322000000010740573663462500156740ustar00tjpcitmbr00000400000017 C*GRGMSG -- print system message (MS-DOS) C+ SUBROUTINE GRGMSG (ISTAT) INTEGER ISTAT C C This routine obtains the text of the VMS system message corresponding C to code ISTAT, and displays it using routine GRWARN. On non-VMS C systems, it just displays the error number. C C Argument: C ISTAT (input): 32-bit system message code. C-- C 1989-Mar-29 C----------------------------------------------------------------------- CHARACTER CBUF*10 C WRITE (CBUF, 101) ISTAT 101 FORMAT(I10) CALL GRWARN('system message number: '//CBUF) END pgplot/sys_dos/groptx.f010064400040640000322000000014410573663462500157270ustar00tjpcitmbr00000400000017 C*GROPTX -- open output text file [MS-DOS] C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE) INTEGER UNIT, MODE CHARACTER*(*) NAME, DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C MODE : 0 to open for reading, 1 to open for writing. C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER IF (MODE.EQ.1) THEN OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER) ELSE OPEN (UNIT=UNIT, FILE=NAME, STATUS='OLD', IOSTAT=IER) END IF GROPTX = IER C----------------------------------------------------------------------- END pgplot/sys_dos/grquit.f010064400040640000322000000007570573663462500157300ustar00tjpcitmbr00000400000017 C*GRQUIT -- report a fatal error and abort execution (MS-DOS) C+ SUBROUTINE GRQUIT (CTEXT) CHARACTER CTEXT*(*) C C Report a fatal error (via GRWARN) and exit with fatal status; a C traceback is generated unless the program is linked /NOTRACE. C C Argument: C CTEXT (input): text of message to be sent to GRWARN. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CALL GRWARN(CTEXT) STOP 'Fatal error in PGPLOT library' END pgplot/sys_dos/grtrml.f010064400040640000322000000011550573663462500157150ustar00tjpcitmbr00000400000017 C*GRTRML -- get name of user's terminal (MS-DOS) C+ SUBROUTINE GRTRML(CTERM, LTERM) CHARACTER CTERM*(*) INTEGER LTERM C C Return the device name of the user's terminal, if any. C C Arguments: C CTERM : receives the terminal name, truncated or extended with C blanks as necessary. C LTERM : receives the number of characters in CTERM, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 1989-Nov-08 C----------------------------------------------------------------------- CTERM = 'CON' LTERM = 3 RETURN END pgplot/sys_dos/grtter.f010064400040640000322000000014040573663462500157120ustar00tjpcitmbr00000400000017 C*GRTTER -- test whether device is user's terminal (MS-DOS) C+ SUBROUTINE GRTTER(CDEV, QSAME) CHARACTER CDEV*(*) LOGICAL QSAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C CDEV : (input) the device name to be tested. C QSAME : (output) .TRUE. is CDEV contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CTERM*64 INTEGER LTERM C CALL GRTRML(CTERM, LTERM) QSAME = (CDEV.EQ.CTERM(:LTERM)) END pgplot/sys_dos/gruser.f010064400040640000322000000010400573663462500157060ustar00tjpcitmbr00000400000017 C*GRUSER -- get user name (MS-DOS) C+ SUBROUTINE GRUSER(CUSER, LUSER) CHARACTER CUSER*(*) INTEGER LUSER C C Return the name of the user running the program. C C Arguments: C CUSER : receives user name, truncated or extended with C blanks as necessary. C LUSER : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 1989-Mar-19 - [AFT] C----------------------------------------------------------------------- C CALL GRGENV('USER', CUSER, LUSER) RETURN END pgplot/cpg/cpgdemo.c010064400040640000322000000106560610774267500151130ustar00tjpcitmbr00000400000017#include "cpgplot.h" #include #include #include #ifndef EXIT_FAILURE #define EXIT_FAILURE 1 #endif #ifndef EXIT_SUCCESS #define EXIT_SUCCESS 0 #endif static void demo1(); static void demo2(); static void demo3(); /* --------------------------------------------------------------------- * Demonstration program for PGPLOT called from C. * (Note that conventions for calling Fortran from C and C from FORTRAN * are system-dependent). * Usage: * cc -c cpgdemo.c * f77 -o cpgdemo cpgdemo.o -lcpgplot -lpgplot -lX11 *---------------------------------------------------------------------- */ int main() { /* * Call ppgbeg to initiate PGPLOT and open the output device; cpgbeg * will prompt the user to supply the device name and type. */ if(cpgbeg(0, "?", 1, 1) != 1) exit(EXIT_FAILURE); cpgask(1); /* * Call each demo. */ demo1(); demo2(); demo3(); /* * Finally, call cpgend to terminate things properly. */ cpgend(); return EXIT_SUCCESS; } static void demo1() { int i; static float xs[] = {1.0, 2.0, 3.0, 4.0, 5.0 }; static float ys[] = {1.0, 4.0, 9.0, 16.0, 25.0 }; float xr[60], yr[60]; int n = sizeof(xr) / sizeof(xr[0]); /* * Call cpgenv to specify the range of the axes and to draw a box, and * cpglab to label it. The x-axis runs from 0 to 10, and y from 0 to 20. */ cpgenv(0.0, 10.0, 0.0, 20.0, 0, 1); cpglab("(x)", "(y)", "PGPLOT Example 1: y = x\\u2\\d"); /* * Mark five points (coordinates in arrays XS and YS), using symbol * number 9. */ cpgpt(5, xs, ys, 9); /* * Compute the function at 'n=60' points, and use cpgline to draw it. */ for(i=0; i fmax) fmax = f[k]; } } /* Clear the screen. Set up window and viewport. */ cpgpage(); cpgsvp(0.05, 0.95, 0.05, 0.95); cpgswin(1.0, (float) nx, 1.0, (float) ny); cpgbox("bcts", 0.0, 0, "bcts", 0.0, 0); cpgmtxt("t", 1.0, 0.0, 0.0, "Contouring using cpgcont()"); /* Draw the map. cpgcont is called once for each contour, using different line attributes to distinguish contour levels. */ cpgbbuf(); for (i=1; i<21; i++) { alev = fmin + i*(fmax-fmin)/20.0; lw = (i%5 == 0) ? 3 : 1; ci = (i < 10) ? 2 : 3; ls = (i < 10) ? 2 : 1; cpgslw(lw); cpgsci(ci); cpgsls(ls); cpgcont(f, nx, ny, 1, nx, 1, ny, &alev, -1, tr); } cpgslw(1); cpgsls(1); cpgsci(1); cpgebuf(); return; } static void demo3() { #define TWOPI (2.0*3.14159265) #define NPOL 6 int i, j, k; int n1[] = {3, 4, 5, 5, 6, 8}; int n2[] = {1, 1, 1, 2, 1, 3}; float x[10], y[10], y0; char* lab[] = {"Fill style 1 (solid)", "Fill style 2 (outline)", "Fill style 3 (hatched)", "Fill style 4 (cross-hatched)"}; /* Initialize the viewport and window. */ cpgbbuf(); cpgsave(); cpgpage(); cpgsvp(0.0, 1.0, 0.0, 1.0); cpgwnad(0.0, 10.0, 0.0, 10.0); /* Label the graph. */ cpgsci(1); cpgmtxt("T", -2.0, 0.5, 0.5, "PGPLOT fill area: routines cpgpoly(), cpgcirc(), cpgrect()"); /* Draw assorted polygons. */ for (k=1; k<5; k++) { cpgsci(1); y0 = 10.0 -2.0*k; cpgtext(0.2, y0+0.6, lab[k-1]); cpgsfs(k); for (i=0; i #include #include #include #ifndef EXIT_SUCCESS #define EXIT_SUCCESS 0 #endif #ifndef EXIT_FAILURE #define EXIT_FAILURE 1 #endif /* * Define the program name, for use in error reporting. */ static char *prgnam = "pgbind"; /* * C prototypes are encoded as one or more consecutive lines in the * comment preamble of PGPLOT source code files. Such lines are * distinguishable from other comment lines by a special comment prefix. * Specify the prefix here. */ #define PG_PREFIX "C%" /* * Specify a maximum for the reasonable length of a C prototype. * This is used to set the buffer size used to process prototypes. */ #define MAX_LINE 256 /* * Specify the max number of arguments expected. Given that the ANSI/ISO * C standard says that a compiler may set a limit as small as 31, * functions with more than this number of arguments are unportable * and should be avoided. We will enforce this limit. */ #define MAX_ARG 31 /* * Enumerate known system types. */ typedef enum {SYS_NON, SYS_BSD, SYS_CRAY2, SYS_VMS, SYS_MS} Systype; /* * Declare a container used to record the specifics of a given * system. */ typedef struct { char *name; /* Name of system template */ Systype type; /* The enumerated type of the system */ char *suffix; /* Suffix to add to subroutine name */ int do_lower; /* If true convert the subroutine name to lower case */ int ltrue; /* FORTRAN logical true */ int lfalse; /* FORTRAN logical false */ char *doc; /* Documentation of the template */ } Sysattr; /* * List known system attributes. */ static Sysattr systable[]={ { "bsd", SYS_BSD, "_", 1, 1, 0, "BSD f77 template. C string pointers are passed directly, but the length of each string is appended as an extra argument to the FORTRAN procedure call." }, { "cray2", SYS_CRAY2, "", 0, 1, 0, "Cray-2 FORTRAN template. C string pointers and lengths are combined into a single argument with the Cray fortran.h _cptofcd(pointer,length) macro." }, { "vms", SYS_VMS, "", 1, -1, 0, "VMS FORTRAN template. C strings are passed via FORTRAN string descriptors." }, { "ms", SYS_MS, "", 0, 1, 0, "Microsoft Powerstation Fortran + Visual C++. Each string argument is passed to the FORTRAN procedure as two adjacent arguments. The first argument is the C char * pointer of the string. The second is an int argument that contains the length of the string. In addition, the C prototype of the FORTRAN function contains a __stdcall qualifier" }, }; static int nsystem = sizeof(systable) / sizeof(systable[0]); /* * Enumerate and list all command-line options. */ typedef enum {OP_NONE, OP_WRAPPER, OP_HEADER, OP_SUFFIX, OP_CASE, OP_FALSE, OP_TRUE} Optype; static struct { Optype type; /* The enumeration identifier of the option */ char *name; /* The command-line option name (including hyphen prefix) */ char *arg; /* A short name for the type of any option argument */ char *doc; /* A short documentation string describing the option */ } options[] = { { OP_WRAPPER, "-w", "", "Write wrapper files." }, { OP_HEADER, "-h", "", "Write a new wrapper-library header file." }, { OP_SUFFIX, "-suffix", "string", "The suffix appended to FORTRAN symbols by the linker." }, { OP_CASE, "-case", "upper|lower", "The typographical case given to FORTRAN symbols by the linker." }, { OP_FALSE, "-false", "integer", "The numerical value of FORTRAN .FALSE." }, { OP_TRUE, "-true", "integer", "The numerical value of FORTRAN .TRUE." }, }; static int noptions = sizeof(options) / sizeof(options[0]); static Optype lookup_option(char *name); /* Enumerate the supported argument data types and C type-qualifiers */ typedef enum {/* FORTRAN C */ DAT_NONE, /* Unknown Unknown */ DAT_VOID, /* (no equivalent) (void) */ DAT_INT, /* INTEGER (int) */ DAT_FLT, /* REAL (float) */ DAT_DBL, /* DOUBLE PRECISION (double) */ DAT_CHR, /* CHARACTER (char) */ DAT_LOG, /* LOGICAL (int) */ /* Type qualifiers */ DAT_CONST /* C const qualifier */ } Typecode; typedef struct { Typecode type; /* Data-type enumerator */ char *name; /* Name of C type */ char *ptr_cast; /* The (type *) cast for pointers of the specified type */ } Datatype; /* * List known data types. */ Datatype datatypes[]={ {DAT_VOID, "void", "(void *)"}, {DAT_INT, "int", "(int *)"}, {DAT_FLT, "float", "(float *)"}, {DAT_DBL, "double", "(double *)"}, {DAT_CHR, "char", "(char *)"}, {DAT_LOG, "Logical", "(Logical *)"}, /* Type qualifiers */ {DAT_CONST, "const", NULL} }; static int ndatatypes = sizeof(datatypes) / sizeof(datatypes[0]); /* * Declare a type used to hold state information for the lexical * analyser. */ typedef struct { char prototype[MAX_LINE];/* C prototype from FORTRAN header */ char buffer[MAX_LINE]; /* Lexical analyser work buffer */ char *last; /* Pointer to the last read token in prototype[] */ char *next; /* Pointer to the next token in prototype[] */ char *bptr; /* Pointer into buffer[] */ char *fname; /* The PGPLOT source file being processed */ FILE *fp; /* File pointer of file 'fname' */ int lnum; /* The current line number in the input file */ } Lex; /* * Declare a function argument descriptor. */ typedef struct { char *name; /* The name of the argument */ char *cast; /* The cast needed to remove constness of argument */ Typecode type; /* The data-type of the argument */ int is_ptr; /* True if the argument is a pointer */ int is_const; /* True if the argument is a const-qualified array */ int is_scalar; /* True if the argument is explicitly marked as scalar */ int length_arg; /* Argument number of associated length argument, or -1 */ } Argument; /* * Declare a function descriptor. */ typedef struct { char *name; /* The name of the function */ Typecode type; /* The data-type returned by the function */ Argument args[MAX_ARG]; /* Array of 'narg' argument descriptors */ int narg; /* The number of arguments in args[] */ } Function; typedef struct { char **files; /* A NULL terminated list of unprocessed PGPLOT source files */ Lex *lex; /* Lexical analyser state container. */ Sysattr sys; /* The attributes of the target system */ int do_header; /* If true write the header file of function prototypes */ int do_wrapper;/* If true, write wrapper function files */ char *header; /* Name of header file */ FILE *hfile; /* File pointer to the open header file */ Function fn; /* The descriptor of the latest wrapper function */ } PGbind; static PGbind *new_PGbind(int argc, char **argv); static PGbind *del_PGbind(PGbind *pg); static int parse_file(PGbind *pg, char *fname); static Lex *new_Lex(void); static Lex *del_Lex(Lex *lex); static int lex_file(Lex *lex, char *fname); static char *lex_line(Lex *lex); static void lex_advance(Lex *lex); static int lex_error(Lex *lex, char *msg, int next); static Typecode read_type(Lex *lex); static char *read_name(Lex *lex); static int read_prototype(Lex *lex); static int usage(void); static void ini_Sysattr(Sysattr *sys); static int decode_prototype(Lex *lex, Function *fn); static int write_prototype(FILE *hfile, Function *fn); static int write_wrapper(Sysattr *sys, Function *fn); static char *type_name(Typecode type); static char *pointer_cast(Typecode type); static int wrap_line(FILE *stream, char *string, int start, int margin, int nmax); static void write_spaces(FILE *stream, int nspace); static int write_symbol(FILE *stream, Sysattr *sys, char *name); /*....................................................................... * Create a C wrapper file or prototype header file for one or more * PGPLOT routines. */ int main(int argc, char *argv[]) { PGbind *pg=NULL; /* pgbind state container */ int waserr = 0; /* True after any error */ /* * Create a new PGbind container. */ pg = new_PGbind(argc, argv); if(pg==NULL) exit(usage()); /* * If a list of files was provided, process each of them in turn, otherwise * take input from stdin. */ if(*pg->files) { while(*pg->files && !(waserr = parse_file(pg, *pg->files))) pg->files++; } else { waserr = parse_file(pg, NULL); }; /* * Clean up. */ pg = del_PGbind(pg); exit(waserr ? EXIT_FAILURE : EXIT_SUCCESS); } /*....................................................................... * Extract marked prototypes from a given file, decode them, and * optionally write wrapper file(s) and append prototypes to the library * header file. * * Input: * pg PGbind * The pgbind state container. * fname char * The name of the file to be processed, or NULL to * select stdin. * Output: * return int 0 - OK. * 1 - Error. */ static int parse_file(PGbind *pg, char *fname) { /* * Connect the specified file to the lexical analyser. */ if(lex_file(pg->lex, fname)) return 1; /* * Read one prototype at a time from the input file and process it. */ while(read_prototype(pg->lex) == 0) { /* * Decompose the prototype. */ if(decode_prototype(pg->lex, &pg->fn)) return 1; /* * Write the header file prototype. */ if(pg->do_header && write_prototype(pg->hfile, &pg->fn)) return 1; /* * Write the wrapper function. */ if(pg->do_wrapper && write_wrapper(&pg->sys, &pg->fn)) return 1; }; return 0; } /*....................................................................... * Display program usage information on stderr. * * Output: * return int EXIT_FAILURE - For use as exit() argument. */ static int usage(void) { int margin; /* The number of characters in a text margin */ int i; /* * Compile the command-line description. */ fprintf(stderr, "Usage: %s template", prgnam); for(i=0; iname); wrap_line(stderr, sys->doc, margin, margin, 75); putc('\n', stderr); /* * List the default options for the current system type. */ write_spaces(stderr, margin); fprintf(stderr, "Default options: "); for(op=0; opsuffix); break; case OP_CASE: fprintf(stderr, " %s %s", option, sys->do_lower ? "lower":"upper"); break; case OP_FALSE: fprintf(stderr, " %s %d", option, sys->lfalse); break; case OP_TRUE: fprintf(stderr, " %s %d", option, sys->ltrue); break; }; }; fprintf(stderr, "\n"); }; /* * List all optional arguments. */ fprintf(stderr, "\n Options:\n"); for(i=0; ifiles = NULL; pg->do_header = 0; pg->do_wrapper = 0; pg->lex = NULL; ini_Sysattr(&pg->sys); pg->header = "cpgplot.h"; pg->hfile = NULL; /* * The first argument must be the name of a recognised system class. */ for(i=0; iname, argv[1])==0) { pg->sys = *sys; break; }; }; /* * System not found? */ if(pg->sys.type == SYS_NON) { fprintf(stderr, "%s: Unrecognised template name: %s\n", prgnam, argv[1]); return del_PGbind(pg); }; /* * Parse command-line options. */ for(i=2; isys.suffix = argv[i]; } else { fprintf(stderr, "%s: Missing argument to the %s option.\n", prgnam, option); return del_PGbind(pg); }; break; /* * Check for the "-case upper|lower" option. */ case OP_CASE: if(++i < argc) { char *value = argv[i]; if(strcmp(value, "upper")==0) pg->sys.do_lower = 0; else if(strcmp(value, "lower")==0) pg->sys.do_lower = 1; else { fprintf(stderr, "%s: Invalid combination: \"%s %s\"\n", prgnam, option, value); return del_PGbind(pg); }; } else { fprintf(stderr, "%s: Missing argument to the %s option.\n", prgnam, option); return del_PGbind(pg); }; break; /* * Write the header prototypes? */ case OP_HEADER: pg->do_header = 1; break; /* * Write wrapper functions? */ case OP_WRAPPER: pg->do_wrapper = 1; break; /* * Override the default logical->int macro. */ case OP_TRUE: if(++i < argc) { char *endp; pg->sys.ltrue = strtol(argv[i], &endp, 0); if(*endp != '\0') { fprintf(stderr, "%s: The argument of %s must be a number.\n", prgnam, option); return del_PGbind(pg); }; } else { fprintf(stderr, "%s: Missing argument to the %s option.\n", prgnam, option); return del_PGbind(pg); }; break; case OP_FALSE: if(++i < argc) { char *endp; pg->sys.lfalse = strtol(argv[i], &endp, 0); if(*endp != '\0') { fprintf(stderr, "%s: The argument of %s must be a number.\n", prgnam, option); return del_PGbind(pg); }; } else { fprintf(stderr, "%s: Missing argument to the %s option.\n", prgnam, option); return del_PGbind(pg); }; break; default: fprintf(stderr, "%s: Unrecognised \"%s\" option.\n", prgnam, option); return del_PGbind(pg); }; }; /* * The remaining arguments must be the names of PGPLOT routine files. */ pg->files = argv + i; /* * Create the lexical analyser. */ pg->lex = new_Lex(); if(pg->lex == NULL) return del_PGbind(pg); /* * If a new header file has been requested, create one. */ if(pg->do_header) { pg->hfile = fopen(pg->header, "w"); if(pg->hfile == NULL) { fprintf(stderr, "%s: Unable to open header file: %s\n", prgnam, pg->header); return del_PGbind(pg); }; /* * Write the header preamble. */ fprintf(pg->hfile, "#ifndef cpgplot_h\n#define cpgplot_h\n\n"); fprintf(pg->hfile, "#ifdef __cplusplus\n"); fprintf(pg->hfile, "extern \"C\" {\n"); fprintf(pg->hfile, "#endif\n\n"); fprintf(pg->hfile, "typedef int Logical;\n\n"); }; /* * Return the initialized container. */ return pg; } /*....................................................................... * Cleanup and delete a PGbind state container. * * Input: * pg PGbind * A container allocated by new_PGbind(). * Output: * return PGbind * Allways NULL. */ static PGbind *del_PGbind(PGbind *pg) { if(pg) { if(pg->hfile) { /* * Write header postamble. */ fprintf(pg->hfile, "\n#ifdef __cplusplus\n"); fprintf(pg->hfile, "}\n"); fprintf(pg->hfile, "#endif\n"); fprintf(pg->hfile, "\n#endif\n"); if(fclose(pg->hfile)) fprintf(stderr, "%s: Error closing header file.\n", prgnam); }; /* * Delete the lexical analyser descriptor. */ pg->lex = del_Lex(pg->lex); }; return NULL; } /*....................................................................... * Search and read the next prototype from the current lexical analyser * input file. Prototypes are distinguishable by the FORTRAN comment prefix: * string assigned to PG_PREFIX (defined at the top of this file). * * Input: * lex Lex * The lexical analyser state container. * Output: * return int 0 - The prototype has been copied succesfully into * lex->prototype[]. * 1 - No prototype found. */ static int read_prototype(Lex *lex) { int noproto=1; /* True until a valid prototype has been read */ int prefix_len; /* The length of the comment prefix string */ /* * Reset the prototype input buffers. */ lex->prototype[0] = '\0'; lex->buffer[0] = '\0'; lex->last = lex->next = lex->prototype; lex->bptr = lex->buffer; /* * Determine the length of the comment prefix that distinguishes prototype * comment lines in the PGPLOT source code file from other lines. */ prefix_len = strlen(PG_PREFIX); /* * Read the file line by line until EOF or until a line starting with * PG_PREFIX[] is encountered. */ while(lex_line(lex) && strncmp(lex->buffer, PG_PREFIX, prefix_len) != 0) ; /* * Did we find a prototype? */ if(!feof(lex->fp) && !ferror(lex->fp)) { int slen=0; /* Accumulated length of prototype */ int finished = 0; /* True when no prorotype continuation lines remain */ /* * Concatenate multiple prototype lines. */ do { /* * Skip the comment prefix. */ lex->bptr = &lex->buffer[prefix_len]; /* * Skip leading white-space. */ while(*lex->bptr && isspace(*lex->bptr)) lex->bptr++; /* * Append the latest line to the last. */ while(*lex->bptr && slenprototype[slen++] = *lex->bptr++; /* * Assume that the prototype is complete, until otherwise proved. */ finished = 1; /* * If the last non-white-space character in the line is a \, then the line is * continued on the next line. */ if(slen < MAX_LINE-1) { int endc; for(endc = slen-1; endc>0 && isspace(lex->prototype[endc]); endc--); if(lex->prototype[endc] == '\\') { slen = endc; finished = 0; }; }; } while(!finished && lex_line(lex) && strncmp(lex->buffer, PG_PREFIX, prefix_len)==0); /* * Check for prototype buffer overflow. */ if(slen >= MAX_LINE-1) { lex_error(lex, "Prototype too long", 0); } else { lex->prototype[slen] = '\0'; lex->next = lex->last = lex->prototype; lex->bptr = &lex->buffer[0]; lex->buffer[0] = '\0'; noproto = 0; }; }; return noproto; } /*....................................................................... * Decode the prototype in pg->fn.prototype[] into a function name and * arguments. * * Input: * lex Lex * The lexical analyser state container. * Input/Output: * fn Function * The container in which to record the function * information. * Output: * return int 0 - OK. * 1 - Error. */ static int decode_prototype(Lex *lex, Function *fn) { int i,j; /* * Read the return data-type of the function. */ if((fn->type = read_type(lex)) == DAT_NONE) return lex_error(lex, "Bad function return type", 0); /* * Only scalar return types are allowed. */ if(*lex->next == '*') return lex_error(lex, "Pointer return types not allowed", 1); /* * Get the function name. */ if((fn->name = read_name(lex)) == NULL) return lex_error(lex, "Bad function name", 0); /* * The next significant character should be an open paren. */ if(*lex->next != '(') return lex_error(lex, "Expected '(' here", 1); else lex_advance(lex); /* * Loop for all arguments up to the close paren. */ for(i=0; inext != ')'; i++) { Argument *arg = &fn->args[i]; /* * Clear the datatype and const-qualifier attributes. */ arg->is_const = 0; arg->type = DAT_NONE; /* * Read the type name and optional type-qualifier of the next argument. */ while(arg->type == DAT_NONE) { Typecode type = read_type(lex); if(type == DAT_NONE) return lex_error(lex, "Unrecognised data-type", 0); /* * Const qualifier or data-type? */ if(type == DAT_CONST) arg->is_const = 1; /* The type will be found in the next iteration */ else arg->type = type; /* This concludes the while() loop */ }; /* * The void type is only valid when used to specify that the function * has no arguments. */ if(arg->type == DAT_VOID) { if(i==0 && *lex->next==')') { fn->narg = 0; break; } else { return lex_error(lex, "void data-type illegal in this context", 0); }; }; /* * Is the argument a pointer or a value? */ if(*lex->next == '*') { arg->is_ptr = 1; lex_advance(lex); if(*lex->next == '*') return lex_error(lex, "Pointer to pointer not allowed", 1); } else { arg->is_ptr = 0; if(arg->is_const) { return lex_error(lex, "Pointless const qualifier to pass-by-value argument.\n", 1); }; }; /* * If the argument is a pointer and is const qualified, record the * cast needed to remove the constness for when the argument is * passed to the FORTRAN subroutine or passed to other functions that while * not modifying the respective argument are not declared with the * appropriate const qualifier. */ arg->cast = (arg->is_ptr && arg->is_const) ? pointer_cast(arg->type) : ""; /* * Get the argument name. */ if((arg->name = read_name(lex)) == NULL) return lex_error(lex, "Bad argument name", 0); /* * Stop when the last argument has been seen. */ if(*lex->next == ',') { lex_advance(lex); } else { fn->narg = i+1; break; }; }; /* * Too many arguments? */ if(i >= MAX_ARG) return lex_error(lex, "Too many arguments", 1); /* * The argument list terminator must be a close paren. */ if(*lex->next == '\0') return lex_error(lex, "Incomplete argument list", 1); else if(*lex->next != ')') return lex_error(lex, "Unexpected character", 1); else { do { lex_advance(lex); } while(*lex->next && (isspace(*lex->next) || *lex->next == ';')); if(*lex->next != '\0') return lex_error(lex, "Unexpected character follows prototype", 1); }; /* * Decode the arguments. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; /* * Initialize the argument attributes with defaults. */ arg->length_arg = -1; arg->is_scalar = 0; /* * Decode any extra type-specific semantics. */ switch(arg->type) { case DAT_CHR: /* * Unless the char argument is explicitly marked as scalar via an * "_scalar" suffix on its name, then it will be treated as a string. */ { char *last_underscore = strrchr(arg->name, '_'); int slen = strlen(arg->name); if(!arg->is_ptr || (last_underscore && strcmp(last_underscore, "_scalar")==0)) { arg->is_scalar = 1; } else { /* * See if there is a length argument associated with the string. */ for(j=0; jnarg; j++) { if(j!=i && strncmp(fn->args[j].name, arg->name, slen)==0 && strcmp(&fn->args[j].name[slen], "_length")==0) { arg->length_arg = j; break; }; }; }; }; break; default: break; }; }; return 0; } /*....................................................................... * Given the initialized descriptor pg->fn, write a C prototype in the * new header file, that is open for write in pg->hfile. * * Input: * hfile FILE * The file pointer to a header file opened for writing. * fn Function * THe descriptor of the function to be prototyped. * Output: * return int 0 - OK. * 1 - Error. */ static int write_prototype(FILE *hfile, Function *fn) { int i; if(hfile) { /* * Write the type and function name and introduce the argument list. */ fprintf(hfile, "%s %s(", type_name(fn->type), fn->name); /* * Write the function arguments. */ if(fn->narg==0) { fprintf(hfile, "void)"); } else { for(i=0; inarg; i++) { fprintf(hfile, "%s%s%s%s%s", fn->args[i].is_const ? "const " : "", type_name(fn->args[i].type), fn->args[i].is_ptr ? " *" : " ", fn->args[i].name, inarg-1 ? ", ":")"); }; }; /* * End the argument list. */ fprintf(hfile, ";\n"); }; return 0; } /*....................................................................... * Given the initialized descriptor pg->fn, write a C wrapper file. * * Input: * sys Sysattr * A list of system attributes. * fn Function * The descriptor of the function to be written. * Output: * return int 0 - OK. * 1 - Error. */ static int write_wrapper(Sysattr *sys, Function *fn) { static char buffer[MAX_LINE]; FILE *wfile; int i; /* * Compose the wrapper file name. */ sprintf(buffer, "%s.c", fn->name); /* * Open the wrapper file. */ if((wfile = fopen(buffer, "w")) == NULL) { fprintf(stderr, "%s: Can't open output wrapper file: %s\n", prgnam, buffer); return 1; }; /* * Allow prototype vs. function definition checking by including the * library header file. */ fprintf(wfile, "#include \"cpgplot.h\"\n"); /* * Extra include files are required when there are string arguments. */ { /* * First determine whether there are any string arguments. */ int has_string = 0; for(i=0; inarg && !has_string; i++) has_string = fn->args[i].type == DAT_CHR; /* * If there are any string arguments, include string.h plus any system * specific string header files. */ if(has_string) { fprintf(wfile, "#include \n"); switch(sys->type) { case SYS_CRAY2: fprintf(wfile, "#include \n"); break; case SYS_VMS: fprintf(wfile, "#include \n"); break; default: break; }; }; }; /* * Declare the return type of the FORTRAN procedure. */ fprintf(wfile, "extern %s ", type_name(fn->type)); switch(sys->type) { case SYS_MS: fprintf(wfile, "__stdcall "); break; default: break; }; write_symbol(wfile, sys, fn->name+1); fprintf(wfile, "();\n"); /* * Write the function declaration. */ fprintf(wfile, "\n%s %s(", type_name(fn->type), fn->name); /* * Write the function arguments. */ if(fn->narg==0) { fprintf(wfile, "void)"); } else { for(i=0; inarg; i++) { fprintf(wfile, "%s%s%s%s%s", fn->args[i].is_const ? "const " : "", type_name(fn->args[i].type), fn->args[i].is_ptr ? " *" : " ", fn->args[i].name, inarg-1 ? ", ":")"); }; }; /* * End the argument list and start the definition block. */ fprintf(wfile, "\n{\n"); /* * Declare intermediate variables. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; switch(arg->type) { case DAT_LOG: fprintf(wfile, " int l_%s = %s ? %d:%d;\n", arg->name, arg->name, sys->ltrue, sys->lfalse); break; case DAT_CHR: fprintf(wfile, " int len_%s = ", arg->name); if(arg->length_arg < 0) { if(arg->is_scalar) fprintf(wfile, "1;\n"); else fprintf(wfile, "strlen(%s);\n", arg->name); } else { fprintf(wfile, "--(%s%s_length);\n", fn->args[arg->length_arg].is_ptr ? "*":"", arg->name); }; if(sys->type == SYS_VMS) fprintf(wfile, " struct dsc$descriptor_s dsc_%s = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};\n", arg->name); break; default: break; }; }; /* * Declare a temporary variable for the return value if required. */ if(fn->type != DAT_VOID) fprintf(wfile, " %s r_value;\n", type_name(fn->type)); /* * Initialize any un-initialized variables. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; switch(arg->type) { case DAT_CHR: if(sys->type == SYS_VMS) { fprintf(wfile, " dsc_%s.dsc$a_pointer = %s%s;\n", arg->name, arg->cast, arg->name); fprintf(wfile, " dsc_%s.dsc$w_length = len_%s;\n", arg->name, arg->name); }; break; default: break; }; }; /* * Cache the return value of the fortran call. */ fprintf(wfile, " %s", fn->type==DAT_VOID ? "":"r_value = "); /* * Write the system-specific symbol used to call the FORTRAN procedure. */ write_symbol(wfile, sys, fn->name+1); /* * Open the argument list. */ putc('(', wfile); /* * Write the FORTRAN arguments. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; /* * Write the argument separator. */ if(i>0) fprintf(wfile, ", "); /* * Handle the data-type specific semantics of passing each argument. */ switch(arg->type) { case DAT_LOG: fprintf(wfile, "&l_%s", arg->name); break; case DAT_CHR: switch(sys->type) { case SYS_CRAY2: fprintf(wfile, "_cptofcd(%s%s, len_%s)", arg->is_ptr ? arg->cast : "&", arg->name, arg->name); break; case SYS_VMS: fprintf(wfile, "&dsc_%s", arg->name); break; case SYS_MS: fprintf(wfile, "%s%s, len_%s", arg->is_ptr ? arg->cast : "&", arg->name, arg->name); break; default: fprintf(wfile, "%s%s", arg->is_ptr ? arg->cast : "&", arg->name); break; }; break; default: fprintf(wfile, "%s%s", arg->is_ptr ? arg->cast : "&", arg->name); break; }; }; /* * Add any extra trailing arguments. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; switch(arg->type) { case DAT_CHR: switch(sys->type) { case SYS_CRAY2: case SYS_VMS: case SYS_MS: break; default: fprintf(wfile, ", len_%s", arg->name); break; }; break; default: break; }; }; /* * Terminate the function call. */ fprintf(wfile, ");\n"); /* * Perform required post-call operations. */ for(i=0; inarg; i++) { Argument *arg = &fn->args[i]; /* * Handle the data-type specific semantics passing each argument. */ switch(arg->type) { case DAT_CHR: if(arg->length_arg >= 0) { fprintf(wfile, " %s%s[%s%s_length] = '\\0';\n", arg->is_ptr ? "":"&", arg->name, fn->args[arg->length_arg].is_ptr ? "*":"", arg->name); }; break; case DAT_LOG: if(arg->is_ptr && !arg->is_const) { fprintf(wfile, " *%s = l_%s==%d ? 1:0;", arg->name, arg->name, sys->ltrue); }; default: break; }; }; /* * Emit a return statement if the function returns a value. */ if(fn->type != DAT_VOID) fprintf(wfile, " return r_value;\n"); /* * Terminate the function definition. */ fprintf(wfile, "}\n"); /* * Close the wrapper file. */ if(fclose(wfile)) { fprintf(stderr, "%s: Error closing wrapper file: %s.c\n", prgnam, fn->name); return 1; }; return 0; } /*....................................................................... * Report a lexical error along with the context of the lexical offset * in to the prototype being decoded. * * Input: * lex Lex * The lexical analyser state container. * msg char * The error message. * next int If true, the context of the error is the next token, * as pointed to by lex->next, otherwise it is the last * token read, a pointed to by lex->last. * Output: * return int Allways 1. This intended to be used where the error * return value of the parent function is 1, such that * the caller can type return lex_error(lex,"...",1); */ static int lex_error(Lex *lex, char *msg, int next) { char *token = next ? lex->next : lex->last; char *start; /* The first character of the prototype to be shown */ int posn; /* Number of chars of context between 'start' and 'token' */ /* * The context of the error will be displayed by showing up to 10 * characters either side of the token pointer. Get the start pointer * of this range. */ start = (token - &lex->prototype[0]) > 10 ? (token-10) : &lex->prototype[0]; /* * Find the number of characters from 'start' at which the token starts. */ posn = (token - start) + 1; /* * Display error messages. */ fprintf(stderr, "%s: Error on line %d of file: %s\n", prgnam, lex->lnum, lex->fname); /* * Prefix the context string. Add the length of the prefix to the * character offset to the start of the offending token. */ posn += fprintf(stderr, "%s: ", prgnam); /* * Write the context string. */ fprintf(stderr, "%.20s...\n", start); /* * Place a caret symbol below the start of the offending token. */ write_spaces(stderr, posn-1); putc('^', stderr); /* * Present the user's error. */ fprintf(stderr, "%s.\n", msg); /* * Return an error status. */ return 1; } /*....................................................................... * Attempt to read a type name via the lexical analyser from the next * unprocessed part of the prototype string, and match it with * a Typecode enumeration identifier. * * Input: * lex Lex * The lexical analyser state container. * Output: * return Typecode The data-type read. On error DAT_NONE is returned * but no error message will have been emitted. */ static Typecode read_type(Lex *lex) { Typecode type = DAT_NONE; /* The return value */ int length; /* The length of the type name */ int i; /* * Skip leading white-space. */ while(*lex->next && isspace(*lex->next)) lex->next++; /* * Save the pointer to the start of the token. */ lex->last = lex->next; /* * Locate the end of the next identifier. */ while(*lex->next && (isalnum(*lex->next) || *lex->next == '_')) lex->next++; /* * Search for the type name in the table of recognised types. */ length = (lex->next - lex->last); for(i=0; type==DAT_NONE && ilast, datatypes[i].name, length) == 0) type = datatypes[i].type; }; /* * Position the lex->next pointer at the start of the next token. */ while(*lex->next && isspace(*lex->next)) lex->next++; /* * Type not recognised. */ return type; } /*....................................................................... * Attempt to read an identifier name via the lexical analyser from the * next unprocessed part of the prototype string, and return a pointer * to a '\0' terminated copy of it, placed in the next unused * part of lex->buffer[]. * * Input: * lex Lex * The lexical analyser state container. * Output: * return Typecode The data-type read. On error DAT_NONE is returned * but no error message will have been emitted. */ static char *read_name(Lex *lex) { char *copy; /* A pointer to the copy of the string in lex->buffer[] */ /* * Skip leading white-space. */ while(*lex->next && isspace(*lex->next)) lex->next++; /* * Save the pointer to the start of the token. */ lex->last = lex->next; /* * Copy the identifier into lex->buffer[], starting at lex->bptr. */ copy = lex->bptr; while(*lex->next && (isalnum(*lex->next) || *lex->next == '_')) *lex->bptr++ = *lex->next++; /* * Terminate the copy. */ *lex->bptr++ = '\0'; /* * Position the lex->next pointer at the start of the next token. */ while(*lex->next && isspace(*lex->next)) lex->next++; /* * If the string has zero length, signal an error by returning NULL. * Otherwise return a pointer to the copy. */ return *copy=='\0' ? NULL : copy; } /*....................................................................... * Return the type name associated with a Typecode enumerator. * * Input: * type Typecode The enumeration identifier to return the name of. * Output: * return char * The name of the associated type, or NULL on error. */ static char *type_name(Typecode type) { int i; for(i=0; ilast = lex->next; /* * Advance over the next unprocessed character. */ lex->next++; /* * Skip white-space up to the start of the next token. */ while(*lex->next && isspace(*lex->next)) lex->next++; return; } /*....................................................................... * Look up a command line option by name. * * Input: * name char * The name of the option to look up. * Output: * return Optype The enumeration identifier of the new type, or * OP_NONE if not recognised. */ static Optype lookup_option(char *name) { int i; for(i=0; i 0) nspace -= fprintf(stream, "%.*s", nspace, " "); return; } /*....................................................................... * Take a single line and wrap it into multiple lines, with an optional * margin. * * Input: * stream FILE * The stream to write to. * string char * The string to be wrapped. * start int The length of the existing pefix on the first line. * This will be padded up to 'margin' with spaces. * margin int The number of characters to pad with spaces * before writing each line. * nmax int The number of characters per line. * Output: * return int The number of characters used on the last line. * This can be used to break up a single call to wrap_line() * into multiple calls, by suplying the return value of the * previous call as the 'start' column value for the next call. */ static int wrap_line(FILE *stream, char *string, int start, int margin, int nmax) { int nnew; /* The number of characters to be written on the next line */ int last=start; /* The column number of the last character written */ int i; /* * Enforce a smaller margin than the line length. */ if(margin > nmax) margin = nmax/10; /* * Write as many lines as are needed to display the whole string. */ for( ; *string; string += nnew, last+=nnew, start=0) { last = start; nnew = -1; /* * Write a margin if requested. */ if(margin>0) { if(start < margin) { write_spaces(stderr, margin-start); last = start = margin; }; }; /* * Skip leading white-space. */ while(isspace(*string)) string++; /* * Locate the end of the last complete word in the string before nmax * characters have been seen. */ for(i=0; string[i] && (ido_lower ? tolower(c):toupper(c), stream); /* * Append a suffix if specified. */ fprintf(stream, "%s", sys->suffix); return 0; } /*....................................................................... * Initialize a system attributes container with default values. * * Input: * sys Sysattr * The container to be initialized. */ static void ini_Sysattr(Sysattr *sys) { sys->name = ""; sys->doc = ""; sys->type = SYS_NON; sys->suffix = ""; sys->do_lower = 0; sys->ltrue = 1; sys->lfalse = 0; } /*....................................................................... * Create a new lexical analyser state descriptor connected to stdin. * * Output: * return Lex * The initialized descriptor, or NULL on error. */ static Lex *new_Lex(void) { Lex *lex = NULL; /* * Allocate the container. */ lex = (Lex *) malloc(sizeof(Lex)); if(lex == NULL) { fprintf(stderr, "%s: Insufficient memory.\n", prgnam); return lex; }; /* * Initialize the descriptor at least up to the point at which it can * safely be sent to del_Lex(). */ lex->prototype[0] = '\0'; lex->buffer[0] = '\0'; lex->last = lex->next = lex->prototype; lex->bptr = lex->buffer; lex->fp = stdin; lex->fname = "(stdin)"; /* * Return the initialized descriptor. */ return lex; } /*....................................................................... * Delete a Lex descriptor and its contents. This includes closing any * file that is assigned to it. * * Input: * lex Lex * A descriptor previously allocated by new_Lex(). * Output: * return Lex * Allways NULL. */ static Lex *del_Lex(Lex *lex) { if(lex) { if(lex->fp) fclose(lex->fp); }; return NULL; } /*....................................................................... * Re-connect a lexical analyser to a new input file. * * Input: * lex Lex * The lexical analyser descriptor. * fname char * The name of the file to be opened, or NULL to * select stdin. * Output: * return int 0 - OK. * 1 - Error. */ static int lex_file(Lex *lex, char *fname) { FILE *fp = NULL; /* * If a file name was given, open the associated file, otherwise * substitute stdin. */ if(fname) { fp = fopen(fname, "r"); } else { fp = stdin; fname = "(stdin)"; }; if(fp == NULL) { fprintf(stderr, "%s: Error opening: %s\n", prgnam, fname); return 1; }; /* * Close any existing file connected to the lexical analyser. */ if(lex->fp && lex->fp != stdin) fclose(lex->fp); /* * Instate the new file. */ lex->fp = fp; lex->fname = fname; lex->lnum = 0; return 0; } /*....................................................................... * Read a new line from a lexical analyser input file. * * Input: * lex Lex * The lexical analyser descriptor. * Output: * return char * Pointer to the buffer lex->buffer[] containing the * line read, or NULL on EOF or other error. */ static char *lex_line(Lex *lex) { char *buff = fgets(lex->buffer, MAX_LINE, lex->fp); if(buff) { char *cptr; /* * Keep a record of the number of the line last read. */ lex->lnum++; /* * Check that the line fitted completely within the available buffer size. */ cptr = strchr(buff, '\n'); /* * Discard the newline character if found. */ if(cptr) { *cptr = '\0'; } else { int c; fprintf(stderr, "%s: Line %d of file %s is too long.\n", prgnam, lex->lnum, lex->fname); do { c = getc(lex->fp); } while(c != '\n' && c!= EOF); return NULL; }; }; return buff; } the lexical analyser from the * next unprocessed part of the prototype string, and return a pointer * to a '\0' terminated copy of it, placed in the next unused * part of lexpgplot/cpg/libgcc_path.sh010074400040640000322000000004070575426302700161120ustar00tjpcitmbr00000400000017#!/bin/sh # Create a dummy C file. echo 'int main() {return 0;}' > dummy.c # Compile and link the dummy file with verbose mode turned on and # capture -L* library paths. gcc -v -o dummy dummy.c 2>&1 | tr ' ' '\012' | egrep '^-L' \rm -f dummy dummy.o dummy.c pgplot/cpg/pgbind_prototypes010064400040640000322000000150310635130416700170060ustar00tjpcitmbr00000400000017C%void cpgarro(float x1, float y1, float x2, float y2); C%void cpgask(Logical flag); C%void cpgaxis(const char *opt, float x1, float y1, float x2, float y2, \ C% float v1, float v2, float step, int nsub, float dmajl, \ C% float dmajr, float fmin, float disp, float orient); C%int cpgband(int mode, int posn, float xref, float yref, float *x,\ C% float *y, char *ch_scalar); C%void cpgbbuf(void); C%int cpgbeg(int unit, const char *file, int nxsub, int nysub); C%void cpgbin(int nbin, const float *x, const float *data, \ C% Logical center); C%void cpgbox(const char *xopt, float xtick, int nxsub, \ C% const char *yopt, float ytick, int nysub); C%void cpgcirc(float xcent, float ycent, float radius); C%void cpgclos(void); C%void cpgconb(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr, \ C% float blank); C%void cpgconf(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float c1, float c2, const float *tr); C%void cpgconl(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float c, const float *tr, const char *label, \ C% int intval, int minint); C%void cpgcons(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr); C%void cpgcont(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, const float *c, int nc, const float *tr); C%void cpgctab(const float *l, const float *r, const float *g, \ C% const float *b, int nc, float contra, float bright); C%int cpgcurs(float *x, float *y, char *ch_scalar); C%void cpgdraw(float x, float y); C%void cpgebuf(void); C%void cpgend(void); C%void cpgenv(float xmin, float xmax, float ymin, float ymax, \ C% int just, int axis); C%void cpgeras(void); C%void cpgerr1(int dir, float x, float y, float e, float t); C%void cpgerrb(int dir, int n, const float *x, const float *y, \ C% const float *e, float t); C%void cpgerrx(int n, const float *x1, const float *x2, \ C% const float *y, float t); C%void cpgerry(int n, const float *x, const float *y1, \ C% const float *y2, float t); C%void cpgetxt(void); C%void cpggray(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float fg, float bg, const float *tr); C%void cpghi2d(const float *data, int nxv, int nyv, int ix1, \ C% int ix2, int iy1, int iy2, const float *x, int ioff, float bias, \ C% Logical center, float *ylims); C%void cpghist(int n, const float *data, float datmin, float datmax, \ C% int nbin, int pgflag); C%void cpgiden(void); C%void cpgimag(const float *a, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float a1, float a2, const float *tr); C%void cpglab(const char *xlbl, const char *ylbl, const char *toplbl); C%void cpglcur(int maxpt, int *npt, float *x, float *y); C%void cpgldev(void); C%void cpglen(int units, const char *string, float *xl, float *yl); C%void cpgline(int n, const float *xpts, const float *ypts); C%void cpgmove(float x, float y); C%void cpgmtxt(const char *side, float disp, float coord, \ C% float fjust, const char *text); C%void cpgncur(int maxpt, int *npt, float *x, float *y, int symbol); C%void cpgnumb(int mm, int pp, int form, char *string, \ C% int *string_length); C%void cpgolin(int maxpt, int *npt, float *x, float *y, int symbol); C%int cpgopen(const char *device); C%void cpgpage(void); C%void cpgpanl(int nxc, int nyc); C%void cpgpap(float width, float aspect); C%void cpgpixl(const int *ia, int idim, int jdim, int i1, int i2, \ C% int j1, int j2, float x1, float x2, float y1, float y2); C%void cpgpnts(int n, const float *x, const float *y, \ C% const int *symbol, int ns); C%void cpgpoly(int n, const float *xpts, const float *ypts); C%void cpgpt(int n, const float *xpts, const float *ypts, int symbol); C%void cpgpt1(float xpt, float ypt, int symbol); C%void cpgptxt(float x, float y, float angle, float fjust, \ C% const char *text); C%void cpgqah(int *fs, float *angle, float *barb); C%void cpgqcf(int *font); C%void cpgqch(float *size); C%void cpgqci(int *ci); C%void cpgqcir(int *icilo, int *icihi); C%void cpgqclp(int *state); C%void cpgqcol(int *ci1, int *ci2); C%void cpgqcr(int ci, float *cr, float *cg, float *cb); C%void cpgqcs(int units, float *xch, float *ych); C%void cpgqdt(int n, char *type, int *type_length, char *descr, \ C% int *descr_length, int *inter); C%void cpgqfs(int *fs); C%void cpgqhs(float *angle, float *sepn, float* phase); C%void cpgqid(int *id); C%void cpgqinf(const char *item, char *value, int *value_length); C%void cpgqitf(int *itf); C%void cpgqls(int *ls); C%void cpgqlw(int *lw); C%void cpgqndt(int *n); C%void cpgqpos(float *x, float *y); C%void cpgqtbg(int *tbci); C%void cpgqtxt(float x, float y, float angle, float fjust, \ C% const char *text, float *xbox, float *ybox); C%void cpgqvp(int units, float *x1, float *x2, float *y1, float *y2); C%void cpgqvsz(int units, float *x1, float *x2, float *y1, float *y2); C%void cpgqwin(float *x1, float *x2, float *y1, float *y2); C%void cpgrect(float x1, float x2, float y1, float y2); C%float cpgrnd(float x, int *nsub); C%void cpgrnge(float x1, float x2, float *xlo, float *xhi); C%void cpgsah(int fs, float angle, float barb); C%void cpgsave(void); C%void cpgunsa(void); C%void cpgscf(int font); C%void cpgsch(float size); C%void cpgsci(int ci); C%void cpgscir(int icilo, int icihi); C%void cpgsclp(int state); C%void cpgscr(int ci, float cr, float cg, float cb); C%void cpgscrl(float dx, float dy); C%void cpgscrn(int ci, const char *name, int *ier); C%void cpgsfs(int fs); C%void cpgshls(int ci, float ch, float cl, float cs); C%void cpgshs(float angle, float sepn, float phase); C%void cpgsitf(int itf); C%void cpgslct(int id); C%void cpgsls(int ls); C%void cpgslw(int lw); C%void cpgstbg(int tbci); C%void cpgsubp(int nxsub, int nysub); C%void cpgsvp(float xleft, float xright, float ybot, float ytop); C%void cpgswin(float x1, float x2, float y1, float y2); C%void cpgtbox(const char *xopt, float xtick, int nxsub, \ C% const char *yopt, float ytick, int nysub); C%void cpgtext(float x, float y, const char *text); C%void cpgtick(float x1, float y1, float x2, float y2, float v, \ C% float tikl, float tikr, float disp, float orient, const char *str); C%void cpgupdt(void); C%void cpgvect(const float *a, const float *b, int idim, int jdim, \ C% int i1, int i2, int j1, int j2, float c, int nc, \ C% const float *tr, float blank); C%void cpgvsiz(float xleft, float xright, float ybot, float ytop); C%void cpgvstd(void); C%void cpgwedg(const char *side, float disp, float width, \ C% float fg, float bg, const char *label); C%void cpgwnad(float x1, float x2, float y1, float y2); pgplot/cpg/extract_prototypes010075500040640000322000000000730627400030700172110ustar00tjpcitmbr00000400000017#!/bin/sh grep -h '^C%' ../src/pg*.f > ./pgbind_prototypes pgplot/cpg/cpgplot.doc010064400040640000322000000220160627400164200154440ustar00tjpcitmbr00000400000017CPGPLOT - An ANSI-C interface to the FORTRAN PGPLOT library. ----------------------------------------------------------- Background ---------- Calling PGPLOT directly from C is a messy, difficult and unportable exercise. This is due to the lack of a universal set of inter-language calling conventions, and to the lack of a standard on how FORTRAN LOGICAL and CHARACTER types are represented in terms of basic machine types. Furthermore, since C implements call-by-value argument passing semantics, whereas FORTRAN uses pass-by-reference, there is the added complication that literal values must be sent indirectly by way of references to dummy variables. The CPGPLOT library adds an intermediate level of wrapper functions between C programs and the PGPLOT library. These functions hide the system dependencies of calling PGPLOT behind a system independent interface. USING THE LIBRARY ----------------- The most important thing to remember when using the CPGPLOT interface library is to include the library header file, cpgplot.h at the top of all C files containing calls to the library. Without this file, the functions will not be correctly prototyped and your code will not work. IMPORTANT CONVENTIONS: 1. The names of the C interface library functions are the same as their PGPLOT counterparts, but are prefixed with a 'c' and written in lower case. 2. The interface implements pass-by-value argument passing semantics. This removes the need for dummy variables, except where arguments are used to return values. 3. Where PGPLOT expects LOGICAL arguments, the C interface requires (int) arguments. Integral zero is interpreted as FORTRAN .FALSE. and non-zero as FORTRAN .TRUE.. FORTRAN call. C equivalent call(s). -------------- ---------------------------- PGASK(.FALSE.) cpgask(0) PGASK(.TRUE.) cpgask(1) or cpgask(2) etc.. 4. Functions that take strings as input require normal C '\0' terminated (char *) strings. 5. Arguments that are used to return FORTRAN strings, must be treated with care. FORTRAN doesn't understand '\0' termination of strings and instead requires that the dimension of the character array be specified along with the array. The interface handles this transparently for input-only strings by using strlen() to determine the length of the string, but for return string arguments it needs to be told the length available in the passed char array. Fortunately all PGPLOT routines that return such strings also have an argument to return the unpadded length of the return string. In CPGPLOT, you must initialize this argument with the dimension of the string array that has been sent. In the prototypes listed in cpgplot.h the length arguments are distinguishable by virtue of their having the name of the string to which they relate, postfixed with "_length". For example, the PGPLOT routine PGQINF() is prototyped as: void cpgqinf(char *item, char *value, int *value_length); Where the 'value_length' argument is the length argument for the string argument 'value'. For example, to write a C function to return 1 if a PGPLOT device is open, or 0 otherwise, one could write. #include "cpgplot.h" int pgplot_is_open(void) { char answer[10]; /* The PGQINF return string */ int answer_len = sizeof(answer); /* allocated size of answer[] */ cpgqinf("STATE", answer, &answer_len); return strcmp(answer, "YES") == 0; } Note that the dimension, sent as the third argument, is the total number of characters allocated to the answer[] array. The interface function actually subtracts one from this when it tells PGPLOT how long the string is. This leaves room for the interface function to terminate the returned string with a '\0'. All returned strings are terminated in this manner at the length returned by PGPLOT in the length argument. LIMITATIONS ----------- Note that PGPLOT procedures that take FORTRAN SUBROUTINEs or FUNCTIONs as arguments are not represented in the CPGPLOT library. Such procedures can not be handled on most systems. RESIDUAL MACHINE DEPENDENCIES ----------------------------- Many system vendors say that if you call FORTRAN functions that do any I/O, you should have a FORTRAN main program, so that the FORTRAN I/O module gets correctly initialized. Since PGPLOT uses FORTRAN I/O, this applies to C programs that call PGPLOT. Linking a C PGPLOT program. -------------------------- Since FORTRAN usually has to be linked with a lot of support libraries, it is usually most convenient to use the FORTRAN compiler to link your C program. If your compiler is not the system-supplied compiler, then it is unlikely that the FORTRAN compiler will cite the correct C run-time library to the linker. This means that you will have to do it yourself. For instance under SunOS 4.x, I use gcc, because the the native C compiler is a pre-ANSI variant. Code generated by this compiler must be linked with libgcc.a. Where this library is located is system dependent, but is often placed in either /usr/local/lib or /usr/local/lib/gcc-lib/machine_type/gcc_version/. In either case, under SunOS/Solaris, if both this path and the path of the installation directory of the pgplot libraries exist in your LD_LIBRARY_PATH environment variable, you can link your program with a statement like: f77 -o blob *.o -lcpgplot -lpgplot -lX11 -lgcc -lm Other systems will have a different name for the LD_LIBRARY_PATH variable, but in general it would be set with something like: "/usr/local/pgplot:/usr/local/lib/gcc-lib/sparc-sun-solaris2.3/2.5.8/" Under csh or tcsh, use the setenv command to set this: setenv LD_LIBRARY_PATH "..." Under sh, bash, ksh: LD_LIBRARY_PATH="..." export LD_LIBRARY_PATH On systems that don't support such a variable, you will have to explicitly specify both the libraries and their paths. For example, under SunOS: f77 -o blob *.o -L/usr/local/pgplot -lcpgplot -lpgplot -lX11 \ -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.3/2.5.8/ -lgcc -lm PORTING TO A NEW SYSTEM ----------------------- Not all systems are supported by the interface library. This is both because we don't have many of the systems here that we would need to create and test any such configuration, and because not all systems can be supported. The program that creates the library for each system is called pgbind (situated in the pgplot/cpg/ directory). To determine whether your system can be supported by this program, compile it with an ANSI-C compiler and run it with no arguments. It will list the available configuration options. If the current version of pgbind does not provide sufficient options to support your system, send us details of how your FORTRAN compiler acts. We need to know: 1. In what form does the FORTRAN compiler export FORTRAN symbol names to the linker. Are the symbol names exported in lower-case, upper case, or in the case that FORTRAN symbols are declared with, and does it prefix or postfix any character or string to symbol names? 2. If you EQUIVALENCE a FORTRAN LOGICAL variable with a FORTRAN INTEGER variable, what are the values of the integer variable when the logical variable is set first to .FALSE. and then to .TRUE.? 3. How does your FORTRAN compiler pass strings? UNIX CONFIGURATION ------------------ If your system is a UNIX system, configured using the makemake script, and it is possible to support your system with one of the available templates, plus zero or more feature overrides, then list the option arguments as the string assigned to the optional PGBIND_FLAGS variable in your system configuration file, re-run the makemake script and type: make cpg This should create the cpgplot.a library, its header file cpgplot.h and a demo program called cpgdemo. If the demo program runs, you are in business. Please tell us what PGBIND_FLAGS string you used so that we can incorporate it in the system configuration file for the next PGPLOT release. NON-UNIX SYSTEMS ---------------- If your system is not a UNIX system, then you will need to find a way to extract specific lines from the PGPLOT source code. Most of the pg*.f files in the src PGPLOT subdirectory contain one or more lines that start with C%. These are C prototypes, which should be extracted complete with the C% prefix and placed, one line after another in a single file. The result of processing this file with pgbind will be a set of C files - one per interface function - and the cpgplot.h library header. Compile the functions and place them in an appropriately named library. PROBLEMS -------- The cpgplot library has not been thoroughly tested, and the pgbind configurations of some systems have not been tested at all. If you have any problems, please send me a list of symptoms, and I will endeavor to solve them through modifications to the pgbind program. HISTORY ------- The pgbind program that creates the library header and interface functions was written by Martin Shepherd. This followed in the footsteps of an earlier program called cbind, written by Jim Morgan. Martin Shepherd (mcs@astro.caltech.edu) pgplot/cpg/pgbind.usage010064400040640000322000000041350631707047200156050ustar00tjpcitmbr00000400000017Usage: pgbind template [-w ] [-h ] [-suffix string] [-case upper|lower] [-false integer] [-true integer] [files] Where template must be one of: bsd BSD f77 template. C string pointers are passed directly, but the length of each string is appended as an extra argument to the FORTRAN procedure call. Default options: -suffix "_" -case lower -false 0 -true 1 cray2 Cray-2 FORTRAN template. C string pointers and lengths are combined into a single argument with the Cray fortran.h _cptofcd(pointer,length) macro. Default options: -suffix "" -case upper -false 0 -true 1 vms VMS FORTRAN template. C strings are passed via FORTRAN string descriptors. Default options: -suffix "" -case lower -false 0 -true -1 ms Microsoft Powerstation Fortran + Visual C++. Each string argument is passed to the FORTRAN procedure as two adjacent arguments. The first argument is the C char * pointer of the string. The second is an int argument that contains the length of the string. In addition, the C prototype of the FORTRAN function contains a __stdcall qualifier Default options: -suffix "" -case upper -false 0 -true 1 Options: -w Write wrapper files. -h Write a new wrapper-library header file. -suffix string The suffix appended to FORTRAN symbols by the linker. -case upper|lower The typographical case given to FORTRAN symbols by the linker. -false integer The numerical value of FORTRAN .FALSE. -true integer The numerical value of FORTRAN .TRUE. Prototype input files: files Each file can contain zero or more C prototypes. Each prototype consists of one or more lines, each line marked with C% in columns 1-2. Continuation lines are heralded by a '\' character at the end of the line being continued. If no files are specified, standard input is read. pgplot/sys_convex/fc_cc.conf010064400040640000322000000077650656367443400166760ustar00tjpcitmbr00000400000017# The Convex fc FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="fc" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_cray/grtermio.c010064400040640000322000000064750567420210600164000ustar00tjpcitmbr00000400000017#ifndef _POSIX_SOURCE #define _POSIX_SOURCE #endif /* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRPTER. */ #include #include #include /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * groter O The open channel number (-1 indicates an error) */ long int GROTER(_fcd cdev, int *ldev) { int fd; /* The returned file descriptor */ char name[64]; /* A copy of the given terminal device name */ /* * Make a copy of the given file if there is sufficient room in name[]. */ if(*ldev <= sizeof(name)-1) { strncpy(name, _fcdtocp(cdev), *ldev); name[*ldev] = '\0'; } else { fprintf(stderr, "groter: Terminal file name too long.\n"); return -1; }; /* * Open the terminal. */ if((fd = open(name, 2)) == -1) { perror(name); return -1; }; return fd; } /* Close a previously opened channel. * * fd I The channel number to be closed */ void GRCTER(int *fd) { close(*fd); return; } /* Write lbuf bytes from cbuf to the channel fd. Data is written without * any formating. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return */ void GRWTER(int *fd, _fcd cbuf, int *lbuf) { int nwritten = write (*fd, _fcdtocp(cbuf), *lbuf); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read */ void GRPTER(int *fd, _fcd cprom, int *lprom, _fcd cbuf, int *lbuf) { char *buff = _fcdtocp(cbuf); /* C pointer to FORTRAN string */ int ndone=0; /* The number of characters read */ struct termios term; /* Terminal mode flags */ /* * Get the current set of terminal mode flags. */ if(tcgetattr(*fd, &term)==0) { struct termios saveterm; /* Saved terminal attributes */ int ntry; /* The number of characters still to be read */ int nread; /* The number of characters read in one iteration */ /* * Save the existing terminal mode flags to be restored later. */ saveterm = term; /* * Enable raw single character input. */ term.c_lflag &= ~ICANON; term.c_cc[VMIN] = 1; /* * Install the new terminal flags after first waiting for all pending * output to be delivered to the terminal and after discarding any * lingering input. */ tcsetattr(*fd, TCSAFLUSH, &term); /* * Prompt for input. */ if(*lprom>0) write(*fd, _fcdtocp(cprom), *lprom); /* * Read up to 'ntry' characters from the terminal. */ ndone = 0; ntry = *lbuf; do { nread = read(*fd, &buff[ndone], ntry); ndone += nread; ntry -= nread; } while(nread>0 && ntry>0); /* * Restore the previous terminal mode flags. */ tcsetattr(*fd, TCSAFLUSH, &saveterm); }; *lbuf=ndone; return; } fprintf(stderr, "groter: Terminal file name too long.\n"); return -1; }; /* * Open the terminal. */ if((fd = open(name, 2)) == -1) { perror(name); return -1; }; return fpgplot/sys_cray/aaaread.me010064400040640000322000000007570637041765200163120ustar00tjpcitmbr00000400000017This version of PGPLOT has been tested on a Cray running UNICOS (version 6). Many of the drivers now compile without modification on the Cray (such as the PostScript, HPGL, QMS, Tektronix, and VT125) The /XDISP driver, and all drivers that use %val() for passing addresses of dynamically-allocated memory [includsing GIF, PPM, etc.], cannot be compiled. Avoid use of these drivers. The following people have contributed to the Cray port: Allyn Tennant, Jose Navarro, D. L. Meier, Bob Sault. pgplot/sys_cray/grfileio.c010064400040640000322000000134300571630127300163370ustar00tjpcitmbr00000400000017#include /*GRFILEIO -- Fast low-level UNIX I/O routines * + * * GRFILEIO is a set of functions that makes fast, low-level Unix I/O routines * available to a Fortran program, accounting for some of the differences in the * C/Fortran interfaces of different machines. * * Specifically, some linkers expect a C-routine which is called from a * Fortran program to have a name ending in an underscore. So, for example, * if the Fortran program calls "grofil()", the C-function's name must * be "grofil_()". Other vendor's (like HP) look for a C-routine with * the actual name as called from Fortran (without the underscore). Therefore, * the following routines link the underscored function name to the same * name without an underscore so that both implementations of the C/Fortran * interface will ultimately call the same low-level routines. * * Secondly, when character strings are passed from Fortran to C, the * string's length is implicitly passed, unbeknownst to the Fortran caller. * Some C/Fortran interfaces put the string length as the next argument after * the string itself; others place the string length at the end of the * argument list. Again, to support both implementations, when a string is * passed to the following routines it is the last argument in the Fortran * call, so that the string and its length are the last two arguments in the * corresponding C-function. * *------- * 2-Dec-92 - fastio.c: John L. Lillibridge, NOAA/NOS/OES Geosciences Lab * 11-Nov-93 - Addition of seekf and warning by Remko Scharroo, DUT/SSR&T * 17-May-94 - Nice manual * 13-Oct-94 - Bits not required by PGPLOT stripped out; routine names * changed [TJP]. * 09-Nov-94 - Tidied and ported to Cray [mcs] (untested). * 10-Nov-94 - Added GRFCH() routine to write FORTRAN CHARACTER sub-strings. *------- */ #include #include #include /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNAME) * INTEGER GROFIL * CHARACTER*(*) FNAME * * Opens file FNAME for writing. * GROFIL returns the file descriptor for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, STRING) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occurred while opening the file. *- */ int GROFIL(_fcd fname) { char *name = _fcdtocp(fname); /* C pointer to FORTRAN string */ int slen = _fctlen(fname); /* Length of the FORTRAN string */ char *buff=0; /* Dynamically allocated copy of name[] */ int fd = -1; /* File descriptor to be returned */ /* * Determine how long the FORTRAN string is by searching for the last * non-blank character in the string. */ while(slen>0 && name[slen-1]==' ') slen--; /* * Dynamically allocate a buffer to copy the FORTRAN string into. */ buff = (char *) malloc((slen+1) * sizeof(char)); if(buff) { /* * Make a C string copy of the FORTRAN string. */ strncpy(buff, name, slen); buff[slen] = '\0'; /* * Open the file and return its descriptor. */ fd = open(buff, O_WRONLY | O_CREAT | O_TRUNC, 0666); free(buff); } else { fprintf(stderr, "gropfil: Insufficient memory\n"); }; return fd; } /* **&GRCFIL -- Close file from GRFILEIO access *+ * FUNCTION GRCFIL (FD) * INTEGER GRCFIL (FD) * * Closes the file with descriptor FD from GRFILEIO access. GRCFIL returns * 0 when properly closed. Otherwise, use PERRORF to report the error. * * Usage: * IOS = GRCFIL (FD) * or: * CALL GRCFIL (FD) * * In the last case the return code is ignored. * * Arguments: * FD (input) : File descriptor returned by GROFIL. * GRCFIL (output) : Error code or 0 on proper closing. *- */ int GRCFIL(int *fd) { return close(*fd); } /* **&GRWFIL -- GRFILEIO write routine *+ * FUNCTION GRWFIL (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFIL * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFIL. If * GRWFIL < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFIL (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFIL(int *fd, int *nbytes, char *buf) { return write(*fd, (void *) buf, *nbytes); } /* **&GRWFCH -- GRFILEIO write FORTRAN character sub-STRING routine *+ * FUNCTION GRWFCH (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFCH * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFCH. If * GRWFCH < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFCH (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFCH(int *fd, int *nbytes, _fcd buf) { return write(*fd, (void *) _fcdtocp(buf), *nbytes); } pgplot/sys_cray/grgmem.c010064400040640000322000000013210567420210600160070ustar00tjpcitmbr00000400000017#include #include /* Fortran callable memory allocator (Cray version). Called as : ier = grgmem (size,pointer) where : size is an integer size of memory to allocate pointer is an integer to return the pointer into */ int GRGMEM(size, pointer) int *size, *pointer; { char *area = malloc(*size); *pointer = (int)area; if (area == NULL) return 0; return 1; } /* Fortran callable memory deallocator Called as : ier = grfmem (size,pointer) where : size is an integer size of memory to deallocate (not used) pointer is an integer that contains the pointer */ int GRFMEM(size, pointer) int *size, *pointer; { char *area = (char *)*pointer; free(area); return 1; } pgplot/sys_cray/cf77_cc.conf010064400040640000322000000100240656367443400164660ustar00tjpcitmbr00000400000017# The Cray cf77 FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="cf77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC='-Wf"-o novector -i64"' # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-O2 -DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="cray2" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_cray/gruser.c010064400040640000322000000023700567420210600160450ustar00tjpcitmbr00000400000017#include /* **GRUSER -- get user name (Cray) *+ * SUBROUTINE GRUSER(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the name of the user running the program. * * Arguments: * STRING : receives user name, truncated or extended with * blanks as necessary. * L : receives the number of characters in VALUE, excluding * trailing blanks. *-- * 09-Nov-1994 - [mcs] Fortran callable C version for CRAY. *----------------------------------------------------------------------- */ char *getlogin(); void GRUSER(_fcd fortran_string, int *length) { int i; /* * Extract the return string pointer and length from the fortran string. */ char *string = _fcdtocp(fortran_string); int maxlen = _fcdlen(fortran_string); /* * Get the login name of the PGPLOT user. */ char *user = getlogin(); /* * If the user name is not available substitute an empty string. */ if(!user) user = ""; /* * Copy the user name to the output string. */ for(i=0; i */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) void GRGETC(int *val) { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct termios term, saveterm; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { tcgetattr(0, &term); saveterm = term; term.c_lflag &= ~( ICANON ); term.c_cc[VMIN] = 1; tcsetattr(0, TCSADRAIN, &term); raw = 1; } tcflush(0, TCIOFLUSH); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tcsetattr(0, TCSADRAIN, &saveterm); raw = 0; } return; } ther the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generatpgplot/sys_cray/grgenv.c010064400040640000322000000053660567420210600160360ustar00tjpcitmbr00000400000017#include #include #include /* **GRGENV -- get value of PGPLOT environment parameter (Cray) *+ * SUBROUTINE GRGENV(NAME, VALUE, L) * CHARACTER*(*) NAME, VALUE * INTEGER L * * Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, * environment parameters are UNIX environment variables; e.g. parameter * ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not * recursive and is case-sensitive. * * Arguments: * NAME : (input) the name of the parameter to evaluate. * VALUE : receives the value of the parameter, truncated or extended * with blanks as necessary. If the parameter is undefined, * a blank string is returned. * L : receives the number of characters in VALUE, excluding * trailing blanks. If the parameter is undefined, zero is * returned. *-- * 09-Nov-1994 - [mcs] Fortran callable C version for CRAY. *----------------------------------------------------------------------- */ void GRGENV(_fcd fortran_name, _fcd fortran_value, int *length) { static char *prefix = "PGPLOT_"; /* Environment variable name prefix */ char test[33]; /* PGPLOT_* Concatenation buffer */ int name_len; /* Un-padded length of 'name' string */ int prefix_len; /* The length of prefix[] */ char *env=0; /* Environment variable value */ int i; /* * Extract the string pointer and dimension of each FORTRAN string argument. */ char *name = _fcdtocp(fortran_name); int name_dim = _fcdlen(fortran_name); char *value = _fcdtocp(fortran_value); int value_dim = _fcdlen(fortran_value); /* * Determine the length of 'name' by searching for the last * non-space character. */ name_len = name_dim; while(name_len > 0 && name[name_len-1] == ' ') name_len--; /* * Determine the length of the prefix. */ prefix_len = strlen(prefix); /* * Prefix 'name' with PGPLOT_ if there is room in test[]. */ if(prefix_len + name_len + 1 <= sizeof(test)/sizeof(char)) { strcpy(test, prefix); strncpy(&test[prefix_len], name, name_len); test[prefix_len+name_len] = '\0'; /* * Get the value of the environment variable now named in test[]. */ env = getenv(test); }; /* * Substitute an empty string if no value was obtained, or the value * obtained is too long to fit in the output string. */ if(env==0 || strlen(env) > value_dim) env = ""; /* * Copy the environment variable value into the output string. */ strncpy(value, env, value_dim); /* * Return the unpadded length of the string. */ { int env_len = strlen(env); *length = (env_len <= value_dim) ? env_len : value_dim; }; /* * Pad the fortran string with spaces. */ for(i = *length; i #include #include /**GRDATE -- get date and time as character string (Cray) *+ * SUBROUTINE GRDATE(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. * To receive the whole string, the STRING should be declared * CHARACTER*17. * * Arguments: * STRING : receives date and time, truncated or extended with * blanks as necessary. * L : receives the number of characters in STRING, excluding * trailing blanks. This will always be 17, unless the length * of the string supplied is shorter. *-- * 09-Nov-1994 - [mcs] Fortran callable C version for CRAY. *----------------------------------------------------------------------- */ void GRDATE(_fcd fortran_string, int *length) { char vtime[18]; /* Output string compilation buffer */ char *utime; /* Returned string from ctime() */ time_t x; /* Time returned by time() */ int i; /* * Extract the return string pointer and length from the fortran string. */ char *string = _fcdtocp(fortran_string); int maxlen = _fcdlen(fortran_string); /* * Get the standard C time string. */ time(&x); utime = ctime(&x); /* * Copy a re-organised version of the time string into vtime[]. */ vtime[0] = utime[8]; vtime[1] = utime[9]; vtime[2] = '-'; vtime[3] = utime[4]; vtime[4] = utime[5]; vtime[5] = utime[6]; vtime[6] = '-'; vtime[7] = utime[20]; vtime[8] = utime[21]; vtime[9] = utime[22]; vtime[10] = utime[23]; vtime[11] = ' '; strncpy(vtime+12, utime+11, 5); vtime[17]='\0'; /* * Copy up to maxlen characters of vtime into the output FORTRAN string. */ strncpy(string, vtime, maxlen); *length = (maxlen < 17) ? maxlen : 17; /* * Pad the FORTRAN string with spaces. */ for(i=17; i /* * This is a wrapper function used to call the /xdisp driver from * CRAY FORTRAN. *-- * 09-Nov-1994 - [mcs] */ void X2DRIV(int *ifunc, float *rbuf, int *nbuf, _fcd chr, int *lchr) { x2driv_(ifunc, rbuf, nbuf, _fcdtocp(chr), lchr, mode, _fcdlen(chr)); } pgplot/sys_cray/xwwrap.c010064400040640000322000000004510567420210600160640ustar00tjpcitmbr00000400000017#include /* * This is a wrapper function used to call the /xwindow driver from * CRAY FORTRAN. *-- * 09-Nov-1994 - [mcs] */ void XWDRIV(int *ifunc, float *rbuf, int *nbuf, _fcd chr, int *lchr, int *mode) { xwdriv_(ifunc, rbuf, nbuf, _fcdtocp(chr), lchr, mode, _fcdlen(chr)); } pgplot/sys_cray/rvwrap.c010064400040640000322000000004450631546352600160700ustar00tjpcitmbr00000400000017#include /* * This is a wrapper function used to call the /xrv driver from * CRAY FORTRAN. *-- * 24-Mar-1997 - [mcs] */ void RVDRIV(int *ifunc, float *rbuf, int *nbuf, _fcd chr, int *lchr, int *mode) { rvdriv_(ifunc, rbuf, nbuf, _fcdtocp(chr), lchr, mode, _fcdlen(chr)); } pgplot/sys_cray/tkwrap.c010064400040640000322000000004450631546343700160600ustar00tjpcitmbr00000400000017#include /* * This is a wrapper function used to call the /xtk driver from * CRAY FORTRAN. *-- * 24-Mar-1997 - [mcs] */ void TKDRIV(int *ifunc, float *rbuf, int *nbuf, _fcd chr, int *lchr, int *mode) { tkdriv_(ifunc, rbuf, nbuf, _fcdtocp(chr), lchr, mode, _fcdlen(chr)); } pgplot/sys_cray/xmwrap.c010064400040640000322000000004500631546337000160560ustar00tjpcitmbr00000400000017#include /* * This is a wrapper function used to call the /xmotif driver from * CRAY FORTRAN. *-- * 24-Mar-1997 - [mcs] */ void XMDRIV(int *ifunc, float *rbuf, int *nbuf, _fcd chr, int *lchr, int *mode) { xmdriv_(ifunc, rbuf, nbuf, _fcdtocp(chr), lchr, mode, _fcdlen(chr)); } pgplot/sys_hp/fort77_c89.conf010064400040640000322000000104550656367443400165470ustar00tjpcitmbr00000400000017# The HP fort77 FORTRAN compiler HP c89 C compiler. # Add -O to FFLAGC and FFLAGD to enable compiler optimization; some # versions of the compiler generate incorrect code with optimization enabled. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/include/X11R5" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/include/Motif1.2/ $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include $XINCL" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="fort77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="+z" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="c89" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="+z -O -D_HPUX_SOURCE" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd -suffix ''" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/lib/X11R5 -lXt -lX11 -lXhp11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/lib/Motif1.2/ -lXm $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.sl" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -b -o $SHARED_LIB" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_hp/aaaread.me010064400040640000322000000041430663605430500157510ustar00tjpcitmbr00000400000017pgplot/sys_hp The *.conf files in this directory are for use with HP-UX (e.g., HP9000 series machines). Note that you need to use the "fort77" interface to the HP-UX Fortran 77 compiler, not "f77". "fort77" provides a POSIX-compliant interface. Some versions of the HP Fortran compiler have problems compiling PGPLOT when optimization is enabled. The problem usually occurs while trying to compile gritoc: gritoc: fort77: Signal 11 (segmentation violation) while compiling /pgplot/src/gritoc.f The problem occurs with level 2 or level 3 optimization with the Fortran 9.0 compiler; the bug is alleged to be fixed in compiler version A.10.0 and later. To disable optimization, edit the file fort77_c89.conf and remove -O on the following two lines: FFLAGC="+z -O" -> FFLAGC="+z" FFLAGD="-O" -> FFLAGD="" before running "makemake" to create the makefile. An alternative workaround is to specify "-K" (static storage) in addition to "-O". [IN view of these problems, I have removed -O from the .conf files.] When reporting problems, please include information about the operating system and compiler, e.g., by executing the following commands. PGPLOT has been tested with the following configuration: % uname -a HP-UX kaa A.09.01 A 9000/720 % what `which fort77` /usr/bin/fort77: HP-UX FORTRAN/9000 08/03/92 (73.53) Series 700 B2408A.09.00 Series 800 B2409B.09.00 % what `which c89` /bin/c89: HP92453-01 A.09.34 HP C Compiler ________________________________________________________________________ If you have problems making the html documentation, you may need to modify the script pgplot/makehtml to invoke perl correctly. One user suggests changing the first two lines to #!/usr/bin/perl eval "exec /usr/bin/perl -S $0 $*" If you do not have perl on your system, you can use the script makehtml.old, but this does not do such a good job; or you can copy the file from the PGPLOT WWW page http://astro.caltech.edu/~tjp/pgplot/subroutines.html ________________________________________________________________________ Tim Pearson (tjp@astro.caltech.edu) 9 Jun 1995 pgplot/sys_hp/fort77_gcc.conf010064400040640000322000000104420656367443500166750ustar00tjpcitmbr00000400000017# The HP fort77 FORTRAN compiler and gcc C compiler. # Add -O to FFLAGC and FFLAGD to enable compiler optimization; some # versions of the compiler generate incorrect code with optimization enabled. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/include/X11R5" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/include/Motif1.2/ $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include $XINCL" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="fort77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="+z" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-fpic -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd -suffix ''" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/lib/X11R5 -lXt -lX11 -lXhp11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/lib/Motif1.2/ -lXm $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.sl" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -b -o $SHARED_LIB" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_hp/g77_gcc.conf010064400040640000322000000102430656367443500161500ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/include/X11R5" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/include/Motif1.2/ $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include $XINCL" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall -fPIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -fpic -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/lib/X11R5 -lXt -lX11 -lXhp11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/lib/Motif1.2/ -lXm $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.sl" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -b -o $SHARED_LIB" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/applications/curvefit/curvefit.doc010064400040640000322000000224330536111462500213740ustar00tjpcitmbr00000400000017c------------------------------------------------------------------------------- c c CurveFit c c A general curve fitting routine using PGPLOT graphics. It works on c VAX/uVAX systems, possibly any system running PGPLOT. c c CurveFit will plot up to 30 data sets (a maximum of 2500 points for c each data set, a maximum of 24000 points total for one graph), saved c as (xp,yp) in ascending {xp} order. Different data sets in one file c must be separated by one non-numeric line. CurveFit can also modify the c data set, by flipping the x and y axes and/or taking logarithms of c either or both of them. Labels and title can be added to the plots. c In addition, CurveFit allows one to fit various types of curves to the c data sets. These are: c c (a) straight line (connect the dots) c (b) cubic spline c (c) smoothing (Bezier) polynomial c (d) low-pass Fourier transform filter c (e) a best-fit polynomial of up to 10 terms c c CurveFit is menu driven and allows one to display all intermediary c results. The x,y plotting ranges are user determined, as is the c fitting range (over the x coordinate). Each type of fit can only be c used once with each data set, though different fits may be used with c the same data set (however, one could load the data set in again and do c the same fit over a different range). Different data sets can have c different symbols and line styles/widths associated with them, so they c can be differentiated. The manner in which the line styles/widths is c determined can be changed if the user so desires, as can the symbols c used to plot the data points. Plots can be made on any device that is c supported by PGPLOT. c c The programme is fairly well documented. A subsantial amount of c virtual memory is required (of the order of 7 Mb), but this can be c decreased by lowering the number of data points that may be plotted. c The following are pseudo-global variables that must be changed in each c subroutine in order for the programme to work. c c MAXPOINTS the maximum number of points allowed per graph c MAXPOINTSET the maximum number of data points per data set c MAXDATASET the maximum number of data sets per graph c NCOEFF the maximum number of coefficients for polynomial c fitting c S2 gives the extra number of points calculated by the c curve fitting routines to make the curves look c smooth, given as 4*MAXPOINTS or 8*MAXPOINTS c c The Bezier polynomial fitting is taken from Borland's TURBO Graphix c Toolbox (translated into FORTRAN), while the cubic spline routines c are partially taken from there, and partially my own algorithm. The c polynomial fitting and the fast Fourier transforms are taken from c the book Numerical Recipes by W.H. Press et al. Except as noted below, c the routines all seem to do what they are supposed to. Note that the c polynomial curve fitting gives the coefficients and their standard c deviation as well. Take these values with a grain of salt! c c Currently, everything seems to work fairly well, except for some c numerical difficulties with the fast Fourier transform that I am c unable to fathom. The problem only becomes noticeable when the FFT c smoothing takes place over more than about 100 data points, when c anomalous step functions appear at intervals of powers of 2. The c step functions get larger as more data points are being smoothed over. c I would appreciate a solution if anyone comes up with one. c c One other minor difficulty discovered occurs when one is taking c logs of more than one data set. It is possible that the endpoints c used for the plotting will not cover the full range of all of the c data sets plotted. A fix would require several more variables, plus c thinking, of which I do not have time at the present. c c Distribute and use this programme as you see fit. If anyone comes c up with major changes or improvements, please send me a copy of the c source code. If anyone wishes a current copy, send me a note, and c the current source code will be sent out to them. I can be reached c at c c BITNET: gill@qucdnast c INTERNET: gill@qucdnast.queensu.ca c c c October 27, 1987 - Fix of subroutine Spline1. It was able to crash c with a particular spacing of {xp}. It was also found c to be incorrect. c Fix to all calculation subroutines, so that the c fit will be made over only the points INSIDE the c given fit range, inclusively, i.e. no extrapolation. c October 28, 1987 - Fix of Subroutine Spline2. It gave discontinuous c spikes at the endpoints. c Add double precision calculations to Spline1 and c Spline2 to allow accurate subtractions/additions. c November 6, 1987 - Fix of calculation procedures that give the range c of the plot. These are now given to 2 digits accuracy. c Add the option to plot or not plot the individual c data points. c November 13, 1987 - Fix the x,y plotting limits when new data sets are c loaded. c Each {xp,yp} pair must be on the same line. Other c information is now allowed on each line after {xp,yp}. c March 8, 1988 - Add READDATA subroutine, that allows one to: c a) skip lines at the beginning before data input, c b) have up to 25 columns of data that can be accessed, c c) read multiple data sets from the same file. c April 21, 1988 - Fix of number of points associated with the data c set number. c The default video and hardcopy devices are now c /VT and /IM, respectively. c May 30, 1988 - Add the option of user inputed line styles/widths. c June 2, 1988 - Correct the problem of bad standard deviations on the c polynomial coefficients. c Add REAL*8 and /G_FLOATING to all of the polynomial c calculations. c June 13, 1988 - Add some idiot-proofing (read `Error checking') of c the curve-fitting routines. c July 27, 1988 - Correct the assignments of the fitting range c variables. c August 29, 1988 - Add error-trapping of non-character data input. c Add scaling (in x and/or y) of any data set. c Add ability to toggle all line drawing and fits for c any data set at any time. c Add user chosen line style/line width combinations. c Add user chosen data point plot symbols. The size of c these is regulated by the total number of points (more c points gives smaller symbols). c Christmas, 1988 - Rearrange the storage method for the data. Now c there is a maximum of 24000 points, or 30 data sets of c 2500 points apiece. This should allow for more c flexibility for the user. c June 21, 1989 - Change the entrance into the routines to allow c multiple changes to data sets without going to the c main menu screen in between each change. c Fix of the log routines. Check that your machine c will assign 0 to 10^-100. c June 22, 1989 - Fix of number of points plotted for various fits. c Now each fit may have a different number of data points. c July 4, 1989 - Fix of spline calculation routines. Splines of more c than one dataset were not saved correctly or plotted. c July 6, 1989 - The default line width, line style will now always c be 1 and 1. c July 11, 1989 - Updated the help file subroutine. c July 14, 1989 - Correct the plot symbol choosing routine. c More idiot-proofing. c Add an UpCase function (works with ASCII only). c August 29, 1989 - Change the order of commands so that the main menu c will not automatically be drawn between commands. To c redraw menu, type in `R' or `M'. c August 31, 1989 - Fix READDATA, so that any data read in will be from c one line only. Before, multiple lines were permitted. c Also, an error message is given if the asked for column c does not exist. The column can then be chosen again. c c Last revision - August 31, 1989 - Arnold Gill c Last revision sent to Tim Pearson (tjp@citphobo) - August 31, 1989 c c------------------------------------------------------------------------------- pgplot/applications/curvefit/curvefit.f010064400040640000322000002567640536111463100210710ustar00tjpcitmbr00000400000017*Date: Fri, 4 May 90 09:15 EST *From: *Subject: Latest version of CurveFit for PGPlot packages - May 4, 1990 c------------------------------------------------------------------------------- c c CurveFit c c A general curve fitting routine using PGPLOT graphics for use on c VAX/uVAX systems, possibly any system capable of running PGPLOT c interactively. c c CurveFit will plot up to 30 data sets (a maximum of 2000 points for c each data set, a maximum of 20000 points total for one graph), saved c as (xp,yp) in ascending {xp} order. Different data sets in one file c must be separated by one non-numeric line. CurveFit can also modify the c data set, by flipping the x and y axes and/or taking logarithms of c either or both of them. Labels and title can be added to the plots. c In addition, CurveFit allows one to fit various types of curves to the c data sets. These are: c c (a) straight line (connect the dots) c (b) cubic spline c (c) smoothing (Bezier) polynomial c (d) low-pass Fourier transform filter c (e) a best-fit polynomial of up to 10 terms c c CurveFit is menu driven and allows one to display all intermediary c results. The x,y plotting ranges are user determined, as is the c fitting range (over the x coordinate). Each type of fit can only be c used once with each data set, though different fits may be used with c the same data set (however, one could load the data set in again and do c the same fit over a different range). Different data sets can have c different symbols and line styles/widths associated with them, so they c can be differentiated. The manner in which the line styles/widths is c determined can be changed if the user so desires, as can the symbols c used to plot the data points. Plots can be made on any device that is c supported by PGPLOT. c c The programme is fairly well documented. A subsantial amount of c virtual memory is required (of the order of 7 Mb), but this can be c decreased by lowering the number of data points that may be plotted. c The following are pseudo-global variables that must be changed in each c subroutine in order for the programme to work. c c MAXPOINTS the maximum number of points allowed per graph c MAXPOINTSET the maximum number of data points per data set c MAXDATASET the maximum number of data sets per graph c NCOEFF the maximum number of coefficients for polynomial c fitting c S2 gives the extra number of points calculated by the c curve fitting routines to make the curves look c smooth, given as 4*MAXPOINTS or 8*MAXPOINTS c c The Bezier polynomial fitting is taken from Borland's TURBO Graphix c Toolbox (translated into FORTRAN), while the cubic spline routines c are partially taken from there, and partially my own algorithm. The c polynomial fitting and the fast Fourier transforms are taken from c the book Numerical Recipes by W.H. Press et al. Except as noted below, c the routines all seem to do what they are supposed to. Note that the c polynomial curve fitting gives the coefficients and their standard c deviation as well. Take these values with a grain of salt! c c Currently, everything seems to work fairly well, except for some c numerical difficulties with the fast Fourier transform that I am c unable to fathom. The problem only becomes noticeable when the FFT c smoothing takes place over more than about 100 data points, when c anomalous step functions appear at intervals of powers of 2. The c step functions get larger as more data points are being smoothed over. c I would appreciate a solution if anyone comes up with one. c c One other minor difficulty discovered occurs when one is taking c logs of more than one data set. It is possible that the endpoints c used for the plotting will not cover the full range of all of the c data sets plotted. A fix would require several more variables, plus c thinking, of which I do not have time at the present. c c Distribute and use this programme as you see fit. If anyone comes c up with major changes or improvements, please send me a copy of the c source code. If anyone wishes a current copy, send me a note, and c the current source code will be sent out to them. I can be reached c at c c BITNET: gill@qucdnast c INTERNET: gill@bill.phy.queensu.ca c c c October 27, 1987 - Fix of subroutine Spline1. It was able to crash c with a particular spacing of {xp}. It was also found c to be incorrect. c Fix to all calculation subroutines, so that the c fit will be made over only the points INSIDE the c given fit range, inclusively, i.e. no extrapolation. c October 28, 1987 - Fix of Subroutine Spline2. It gave discontinuous c spikes at the endpoints. c Add double precision calculations to Spline1 and c Spline2 to allow accurate subtractions/additions. c November 6, 1987 - Fix of calculation procedures that give the range c of the plot. These are now given to 2 digits accuracy. c Add the option to plot or not plot the individual c data points. c November 13, 1987 - Fix the x,y plotting limits when new data sets are c loaded. c Each {xp,yp} pair must be on the same line. Other c information is now allowed on each line after {xp,yp}. c March 8, 1988 - Add READDATA subroutine, that allows one to: c a) skip lines at the beginning before data input, c b) have up to 25 columns of data that can be accessed, c c) read multiple data sets from the same file. c April 21, 1988 - Fix of number of points associated with the data c set number. c The default video and hardcopy devices are now c /VT and /IM, respectively. c May 30, 1988 - Add the option of user inputed line styles/widths. c June 2, 1988 - Correct the problem of bad standard deviations on the c polynomial coefficients. c Add REAL*8 and /G_FLOATING to all of the polynomial c calculations. c June 13, 1988 - Add some idiot-proofing (read `Error checking') of c the curve-fitting routines. c July 27, 1988 - Correct the assignments of the fitting range c variables. c August 29, 1988 - Add error-trapping of non-character data input. c Add scaling (in x and/or y) of any data set. c Add ability to toggle all line drawing and fits for c any data set at any time. c Add user chosen line style/line width combinations. c Add user chosen data point plot symbols. The size of c these is regulated by the total number of points (more c points gives smaller symbols). c Christmas, 1988 - Rearrange the storage method for the data. Now c there is a maximum of 20000 points, or 30 data sets of c 2000 points apiece. This should allow for more c flexibility for the user. c June 21, 1989 - Change the entrance into the routines to allow c multiple changes to data sets without going to the c main menu screen in between each change. c Fix of the log routines. Check that your machine c will assign 0 to 10^-100. c June 22, 1989 - Fix of number of points plotted for various fits. c Now each fit may have a different number of data points. c July 4, 1989 - Fix of spline calculation routines. Splines of more c than one dataset were not saved correctly or plotted. c July 6, 1989 - The default line width, line style will now always c be 1 and 1. c July 11, 1989 - Updated the help file subroutine. c July 14, 1989 - Correct the plot symbol choosing routine. c More idiot-proofing. c Add an UpCase function (works with ASCII only). c August 29, 1989 - Change the order of commands so that the main menu c will not automatically be drawn between commands. To c redraw menu, type in `R' or `M'. c August 31, 1989 - Fix READDATA, so that any data read in will be from c one line only. Before, multiple lines were permitted. c Also, an error message is given if the asked for column c does not exist. The column can then be chosen again. c November 23, 1989 - Update dataset number entry, so that multiple sets c may be included on the same line, including the 0 dataset c (to quit asking). User is informed of entry errors and c reprompted. c Programme will announce when a particular data file c has been used up and closed. c If one overshoots a data line, typing 'B' will go c back one line. Typing 'Bn' will go back n lines. c CurveFit is never case-sensitive. One can also go back c n lines from the first lineskip prompt. c More error checking added - it is much harder to get c it to crash now. c January 5, 1990 - The subroutine SCALEDATASET has been added. It c includes the expansion/contraction of before, as well as c the ability to slide data sets around the graph, and to c subtract or add one data set from/to another. c March 14, 1990 - Using BACKSPACE to go backwards through a file is c very bad programming, as BACKSPACE = REWIND + (n-1) READ, c so keep track of line number in file, and do the c REWIND/READ combo in software. c April 6, 1990 - Add confirmation when leaving CurveFit. c May 4, 1990 - Correct backspacing through a data file. c c Last revision - May 4, 1990 - Arnold Gill c Last revision to Tim Pearson (tjp@deimos.caltech.edu) - May 4, 1990 c c------------------------------------------------------------------------------- PROGRAM CurveFit c INTEGER maxpoints,s2,ncoeff,maxdataset,dataset,ierror,i,j,ma, * totalpoints,cdataset,ChooseDataSet,ii,maxpointset,offset,m,n PARAMETER (maxpoints=20000,s2=8*maxpoints,ncoeff=10, * maxdataset=30,maxpointset=2000) c c ----- The PARAMETER statement exists in many SUBROUTINEs, as needed. c Any changes to MAXPOINTS, MAXPOINTSET, NCOEFF, MAXDATASET must be c done in all of them. c REAL xdata(maxpointset),ydata(maxpointset),x(maxpoints), * y(maxpoints),zero,xbez(s2),ybez(s2),xspl(s2),yspl(s2), * coeff(ncoeff,2),xfr(maxpoints),yfr(maxpoints),r1,r2,r3,r4, * xpoly(s2),ypoly(s2),x1,x2,y1,y2,f1,f2,one, * scale,xminmax(2,maxdataset),yminmax(2,maxdataset) INTEGER power(ncoeff),xstart(maxdataset,2),styles(maxdataset,3) * ,maxply(maxdataset),maxfr(maxdataset),maxbez(maxdataset), * maxspl(maxdataset) CHARACTER xlabel*80,ylabel*80,title*80,blank*40,video*3, * hardcopy*3,ans*1,datain*80,outstring*80,UpCase*1 LOGICAL labels,xlog(maxdataset),ylog(maxdataset),f,t,flip, * fits(5,maxdataset),points,fileopen,linestyle,quit,ok c DATA blank/' '/ DATA f/.FALSE./,t/.TRUE./,one/1.0/,zero/0.0/ c COMMON /PlyDat/xpoly,ypoly,coeff,power,maxply,ma COMMON /SplDat/xspl,yspl,maxspl,/BezDat/xbez,ybez,maxbez COMMON /FrDat/xfr,yfr,maxfr COMMON /XYDat/x,y,xdata,ydata,xminmax,yminmax c c ----- Opening title c c WRITE (*,'('1')') c WRITE (*,98) 'Display the general description [n] ? ' c READ (*,97) ans c ans=UpCase(ans) c IF (ans.EQ.'Y') CALL Description c c ----- Choose the display device to use. Unless you have the latest c version of PGPLOT, comment out the next program line. c WRITE (*,100) 100 FORMAT ('1'///10X,'Choose your video display terminal'///10X, * '(Default device is /VT)'//) CALL PGLDEV WRITE (*,*) video=' ' READ (*,97) video IF (video(1:1).NE.'/') video='/vt' y1=1E35 y2=-y1 x1=y1 x2=-y1 dataset=0 xlabel=blank//blank ylabel=blank//blank title=blank//blank labels=f fileopen=f linestyle=f totalpoints=0 ierror=0 c c ----- Data input c CALL ReadData (dataset,xstart,x1,y1,x2,y2,fileopen,totalpoints) f1=x1 f2=x2 points=f DO 112 i=1,maxdataset styles(i,1)=1 styles(i,2)=1 styles(i,3)=-1 DO 111 j=1,5 fits(j,i)=f 111 CONTINUE xlog(i)=f ylog(i)=f 112 CONTINUE fits(1,dataset)=t 1 CONTINUE c c ----- Main menu for data and plot manipulation c CALL Menu (ans,fits,dataset,xlog,ylog,flip,labels,points, * linestyle,x1,x2,y1,y2,f1,f2) GOTO 1112 1111 CONTINUE WRITE (*,*) WRITE (*,98) 'Input command [`M'' for Menu, to plot'// * ' graph]: ' READ (*,97) ans ans=UpCase(ans) IF (ans.EQ.'M') GOTO 1 1112 CONTINUE IF (((ans.LT.'1').OR.(ans.GT.'9')).AND. * (ans.NE.'H').AND.(ans.NE.'X').AND.(ans.NE.'Q').AND. * (ans.NE.'E').AND.(ans.NE.'L').AND.(ans.NE.'F').AND. * (ans.NE.'N').AND.(ans.NE.'T').AND.(ans.NE.'A').AND. * (ans.NE.'D').AND.(ans.NE.'S').AND.(ans.NE.'V')) THEN c c ----- Plot data with current values for parameters c CALL Plot (xstart,x1,x2,y1,y2,f1,f2,xlabel,ylabel,title,labels, * points,video,fits,dataset,f,totalpoints,styles,linestyle) CALL Menu (ans,fits,dataset,xlog,ylog,flip,labels,points, * linestyle,x1,x2,y1,y2,f1,f2) GOTO 1112 ELSE IF (ans.EQ.'1') THEN c c ----- Toggle the straight line data connecting from PGPLOT from c chosen data set c 2 CONTINUE WRITE (*,'((A),(A),I2)') '0(Dis)Connect the points of which ', * 'dataset(s) : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset' datain=blank//blank READ (*,97) datain CALL ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) IF (.NOT.quit) GOTO 2 ELSE IF (ans.EQ.'2') THEN c c ----- Toggle and calculate the cubic spline fitting routine for c the chosen data set c 3 CONTINUE WRITE (*,'((A),(A),I2)') '0Fit Cubic splines to which ', * 'dataset(s) : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset' datain=blank//blank READ (*,97) datain CALL ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) IF (.NOT.quit) GOTO 3 ELSE IF (ans.EQ.'3') THEN c c ----- Toggle and calculate the Bezier polynomial data smoothing c for the chosen data set c 4 CONTINUE WRITE (*,'((A),(A),I2)') '0Fit a Bezier polynomial to which', * ' dataset(s) : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset' datain=blank//blank READ (*,97) datain CALL ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) IF (.NOT.quit) GOTO 4 ELSE IF (ans.EQ.'4') THEN c c ----- Toggle and calculate the Fourier transform data smoothing c for the chosen data set c 5 CONTINUE WRITE (*,'((A),(A),I2)') '0Smooth using an FFT of which ', * 'dataset(s) : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset' datain=blank//blank READ (*,97) datain CALL ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) IF (.NOT.quit) GOTO 5 ELSE IF (ans.EQ.'5') THEN c c ----- Toggle and calculate the best fit polynomial of data for the c chosen data set c 6 CONTINUE WRITE (*,'((A),(A),I2)') '0Fit a polynomial to which ', * 'dataset(s) : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset, multiple' * //' entries allowed' datain=blank//blank READ (*,97) datain CALL ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) IF (.NOT.quit) GOTO 6 ELSE IF (ans.EQ.'6') THEN c c ----- Toggle and calculate the base 10 logs of the x,y data as requested c for the chosen data set c 65 CONTINUE j=2 outstring=blank//blank DO 7 i=1,dataset IF (xlog(i).OR.ylog(i)) THEN WRITE (outstring(j:j+1),'(I2)') i j=j+3 ENDIF 7 CONTINUE IF (j.GT.2) THEN WRITE (*,97) '0Logs are already calculated for data sets # :' WRITE (*,97) outstring ENDIF 8 CONTINUE WRITE (*,'((A),I2)') '0Take logs of which dataset : 1 - ', * dataset WRITE (*,*) ' 0 to quit, = current dataset' READ (*,97) datain IF (datain(1:1).EQ.'0') GOTO 1006 cdataset=ChooseDataSet(datain,dataset,ok) IF (.NOT.ok) GOTO 8 IF ((cdataset.GT.dataset).OR.(cdataset.LT.1)) THEN WRITE (*,99) 7,7,'Error in input. Reenter data set number' GOTO 8 ENDIF offset=xstart(cdataset,1)-1 WRITE (*,*) WRITE (*,98) 'Take logs of x data [n]: ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN IF (.NOT.xlog(cdataset)) THEN xlog(cdataset)=t x1=1.0E35 x2=-1.0E35 DO 9 i=1,xstart(cdataset,2) IF (x(offset+i).GT.zero) THEN x(offset+i)=LOG10(x(offset+i)) x1=MIN(x(offset+i),x1) x2=MAX(x(offset+i),x2) ELSE WRITE (*,99) 7,7,'Error - log of a non-positive number' x(offset+i)=-100.0 ENDIF 9 CONTINUE DO 10 i=2,5 fits(i,cdataset)=f 10 CONTINUE ENDIF ELSE IF (xlog(cdataset)) THEN xlog(cdataset)=f x1=1.0E35 x2=-1.0E35 DO 11 i=1,xstart(cdataset,2) x(offset+i)=1.0D1**DBLE(x(offset+i)) x1=MIN(x(offset+i),x1) x2=MAX(x(offset+i),x2) 11 CONTINUE DO 12 i=2,5 fits(i,cdataset)=f 12 CONTINUE ENDIF WRITE (*,98) 'Take logs of y data [n]: ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN IF (.NOT.ylog(cdataset)) THEN ylog(cdataset)=t y1=1.0E35 y2=-1.0E35 DO 13 i=1,xstart(cdataset,2) IF (y(offset+i).GT.zero) THEN y(offset+i)=LOG10(y(offset+i)) y1=MIN(y(offset+i),y1) y2=MAX(y(offset+i),y2) ELSE WRITE (*,99) 7,7,'Error - log of a non-positive number' y(offset+i)=-100.0 ENDIF 13 CONTINUE DO 14 i=2,5 fits(i,cdataset)=f 14 CONTINUE ENDIF ELSE IF (ylog(cdataset)) THEN ylog(cdataset)=f y1=1.0E35 y2=-1.0E35 DO 15 i=1,xstart(cdataset,2) y(offset+i)=1.0D1**DBLE(y(offset+i)) y1=MIN(y(offset+i),y1) y2=MAX(y(offset+i),y2) 15 CONTINUE DO 16 i=2,5 fits(i,cdataset)=f 16 CONTINUE ENDIF CALL SetLimits (x1,x2) CALL SetLimits (y1,y2) f1=x1 f2=x2 GOTO 65 1006 CONTINUE ELSE IF (ans.EQ.'7') THEN c c ----- Set the range of the x coordinate to plot c ii=1 17 CONTINUE WRITE (*,96) '0Current plotting range of x-coordinate is [ ', * x1,' to ',x2,' ]' WRITE (*,98) 'Enter new range: ' READ (*,*,ERR=1000,IOSTAT=ierror) x1,x2 IF (x1.EQ.x2) THEN x2=x2+one ELSE IF (x1.GT.x2) THEN CALL Swap (x1,x2) ENDIF f1=MIN(f1,x1) f2=MAX(f2,x2) ELSE IF (ans.EQ.'8') THEN c c ----- Set the range of the y coordinate to plot c ii=2 18 CONTINUE WRITE (*,96) '0Current plotting range of y-coordinate is [ ', * y1,' to ',y2,' ]' WRITE (*,98) 'Enter new range: ' READ (*,*,ERR=1000,IOSTAT=ierror) y1,y2 IF (y1.EQ.y2) THEN y2=y2+one ELSE IF (y1.GT.y2) THEN CALL Swap (y1,y2) ENDIF ELSE IF (ans.EQ.'9') THEN c c ----- Set the range of the x coordinate over which to use the c different fitting routines c ii=3 19 CONTINUE WRITE (*,96) '0Current fitting range of x-coordinate is [ ', * f1,' to ',f2,' ]' WRITE (*,98) 'Enter new range: ' READ (*,*,ERR=1000,IOSTAT=ierror) f1,f2 IF (f1.EQ.f2) THEN f2=f2+one ELSE IF (f1.GT.f2) THEN CALL Swap (f1,f2) ENDIF ELSE IF (ans.EQ.'V') THEN c c ----- Choose the display device to use. Unless you have the latest c version of PGPLOT, comment out the next program line. c WRITE (*,1900) 1900 FORMAT ('0',10X,'Choose your video display terminal'//10X, * '(Default device is /VT)'//) CALL PGLDEV WRITE (*,*) video=' ' READ (*,97) video IF (video(1:1).NE.'/') video='/vt' ELSE IF (ans.EQ.'N') THEN c c ----- Get a new data file to analyse and start a new plot c WRITE (*,98) 'This will erase the current plot. Proceed'// * ' [n] ? ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN y1=1E35 y2=-y1 x1=y1 x2=-y1 dataset=0 xlabel=blank//blank ylabel=blank//blank title=blank//blank labels=f DO 205 i=1,maxdataset styles(i,1)=1 styles(i,2)=1 styles(i,3)=-1 DO 20 j=1,5 fits(j,i)=f 20 CONTINUE xlog(i)=f ylog(i)=f 205 CONTINUE fits(1,1)=t points=f linestyle=f CALL ReadData (dataset,xstart,x1,y1,x2,y2,fileopen, * totalpoints) f1=x1 f2=x2 ENDIF ELSE IF (ans.EQ.'A') THEN c c ----- Add a new data file to current plot. MAXDATASET data sets are c permitted. c IF (dataset.EQ.maxdataset) THEN WRITE (*,99) 7,7,'No more room for additional data sets' ELSE Call ReadData (dataset,xstart,x1,y1,x2,y2,fileopen, * totalpoints) xlog(dataset)=f ylog(dataset)=f fits(1,dataset)=t DO 21 i=2,5 fits(i,dataset)=f 21 CONTINUE f1=x1 f2=x2 ENDIF ELSE IF (ans.EQ.'F') THEN c c ----- Exchange the x and y axes, with the various fits being set to c false (i.e. they need to be redone) c 22 CONTINUE WRITE (*,'((A),(A),I2)') '0Flip the X-Y axes of which ', * 'dataset : 1 - ',dataset WRITE (*,*) ' 0 to quit, = current dataset' READ (*,97) datain IF (datain(1:1).EQ.'0') GOTO 1007 cdataset=ChooseDataSet(datain,dataset,ok) IF (.NOT.ok) GOTO 22 IF ((cdataset.GT.dataset).OR.(cdataset.LT.1)) THEN WRITE (*,99) 7,7,'Error in input. Reenter data set number' GOTO 22 ENDIF DO 23 i=1,xstart(cdataset,2) CALL Swap (x(offset+i),y(offset+i)) 23 CONTINUE fits(1,cdataset)=t DO 24 i=2,5 fits(i,cdataset)=f 24 CONTINUE flip=.NOT.flip CALL Swap (x1,y1) CALL Swap (x2,y2) f1=x1 f2=x2 GOTO 22 1007 CONTINUE ELSE IF (ans.EQ.'H') THEN c c ----- Choose the hardcopy device, and send it c WRITE (*,101) 101 FORMAT ('1'///10X,'Choose your hardcopy device:'///10X, * '(Default device is /IM)'//) CALL PGLDEV WRITE (*,*) hardcopy=' ' READ (*,97) hardcopy IF (hardcopy(1:1).NE.'/') hardcopy='/im' CALL Plot (xstart,x1,x2,y1,y2,f1,f2,xlabel,ylabel,title,labels, * points,hardcopy,fits,dataset,t,totalpoints,styles, * linestyle) ELSE IF (ans.EQ.'S') THEN CALL ScaleDataSet (x1,x2,y1,y2,fits,xstart,dataset) ELSE IF (ans.EQ.'T') THEN c c ----- Place and toggle labels and title on the plot c IF (labels) THEN WRITE (*,*) WRITE (*,98) 'Remove the title/labels [n] ? ' READ (*,97) ans IF (UpCase(ans).NE.'Y') THEN WRITE (*,*) WRITE (*,98) 'Change the title/labels [y] ? ' READ (*,97) ans IF (UpCase(ans).NE.'N') THEN WRITE (*,*) WRITE (*,98) 'Change the x-axis label [n] ? ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,*) xlabel WRITE (*,*) 'Enter the new x-axis label :' READ (*,97) xlabel ENDIF WRITE (*,*) WRITE (*,98) 'Change the y-axis label [n] ? ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,*) ylabel WRITE (*,*) 'Enter the new y-axis label :' READ (*,97) ylabel ENDIF WRITE (*,*) WRITE (*,98) 'Change the title [n] ? ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,*) title WRITE (*,*) 'Enter the new title of the plot :' READ (*,97) title ENDIF ENDIF ELSE labels=f ENDIF ELSE labels=t WRITE (*,*) 'Enter the x-axis label :' READ (*,97) xlabel WRITE (*,*) 'Enter the y-axis label :' READ (*,97) ylabel WRITE (*,*) 'Enter the title of the plot :' READ (*,97) title ENDIF ELSE IF (ans.EQ.'D') THEN c c ----- Toggle the plotting of the data points c points=.NOT.points IF (points) THEN WRITE (*,3200) dataset 3200 FORMAT ('0There is/are currently ',I2, * ' different set(s) of data plotted.'//,4X, * 'Choose the symbol for graphing of data points from the', * ' table below'//,19X, * '(-1) do not plot this dataset'//,12X, * '(2) plus sign',13X,'(12) open star'/,12X * '(3) asterisk',14X,'(13) filled triangle'/,12X, * '(4) open circle',11X,'(14) open cross'/,12X, * '(5) times sign',12X,'(15) star of david'/,12X, * '(6) open square',11X,'(16) filled square'/,12X, * '(7) open triangle',9X,'(17) filled circle'/,12X, * '(10) hyperbolic square',5X,'(18) filled star'/,12X, * '(11) open diamond'//) WRITE (*,*) ii=4 DO 36 i=1,dataset 34 CONTINUE WRITE (*,'((A),I2,(A),$)') ' Choice for data set #',i,': ' READ (*,*,ERR=1000,IOSTAT=ierror) m IF (.NOT.(((m.GE.2).AND.(m.LE.7)).OR. * ((m.GE.10).AND.(m.LE.18)).OR.(m.EQ.-1))) GOTO 1000 styles(i,3)=m 36 CONTINUE ELSE DO 37 i=1,maxdataset styles(i,3)=-1 37 CONTINUE ENDIF ELSE IF (ans.EQ.'L') THEN c c ----- Toggle the choice of linestyle to and from USER / SYSTEM, and c set the user's choice of linestyle. c linestyle=.NOT.linestyle IF (linestyle) THEN WRITE (*,3700) dataset 3700 FORMAT ('0There is/are currently ',I2, * ' different set(s) of data plotted.'//,4X, * 'Choose the line style and the line width from'/,2X, * 'the table below and enter as ls,lw (ex 1,9)'//,5X, * 'Line style: 1) solid line'/,21X, * '2) long dashes'/,21X,'3) dash-dot-dash'/,21X, * '4) dotted'/,21X,'5) dash-dot-dot-dot'//,5X, * 'Line width: 1 through 21'//) ii=5 DO 40 i=1,dataset 38 CONTINUE WRITE (*,'((A),I2,(A),$)') ' Choice for data set #',i,': ' READ (*,*,ERR=1000,IOSTAT=ierror) m,n IF ((m.LT.1).OR.(m.GT.5).OR.(n.LT.1).OR.(n.GT.21)) GOTO 1000 styles(i,1)=m styles(i,2)=n 40 CONTINUE ELSE DO 41 i=1,dataset styles(i,1)=1 styles(i,2)=1 41 CONTINUE ENDIF ELSE WRITE (*,*) WRITE (*,'(2A1,(A))') 7,7,'Confirm exit from CurveFit - enter'// * ' a capital `C'': ' READ (*,97) ans c c ----- Quit the programme CurveFit - requires an upper-case `C' c IF (ans.EQ.'C') STOP ENDIF GOTO 1111 c c ----- Error checking/error flag resetting routine. c 1000 CONTINUE WRITE (*,99) 7,7,'*** Error in input - redo! ***' IF (ierror.GT.0) CALL ERRTST (ierror,m) GOTO (17,18,19,34,38),ii 96 FORMAT ((A),E10.3,A4,E10.3,A2) 97 FORMAT ((A)) 98 FORMAT (1X,(A),$) 99 FORMAT ('0',2(A1),(A)) END c c------------------------------------------------------------------------------- c SUBROUTINE ToggleDataSet (fits,xstart,f1,f2,ans,datain,dataset, * maxdataset,quit) c c ----- Takes an input string of dataset numbers, separates them and c operates on the valid values. Errors are detected and the user is c notified. This allows more than one data set number to be included c on each input line, including the 0 data set which quits entry. All c numbers after 0 on the entry line are ignored. c REAL f1,f2 INTEGER dataset,maxdataset,xstart(maxdataset,2),ind,last,ians, * cdataset,ierror,j LOGICAL quit,fits(5,maxdataset),ok CHARACTER ans*1,datain*80,ch*1 c ians=ICHAR(ans)-ICHAR('0') last=80 ind=1 c c ----- Determine the length of the input string. If zero, default is used. c DO 1 last=80,1,-1 ch=datain(last:last) IF ((ch.GE.'0').AND.(ch.LE.'9')) GOTO 2 1 CONTINUE last=0 GOTO 3 2 CONTINUE last=last+1 3 CONTINUE IF (last.EQ.0) THEN cdataset=dataset GOTO 5 ENDIF 4 CONTINUE c c ----- Read the dataset number from the given passed substring c READ (datain(ind:last),*,IOSTAT=ierror) cdataset IF (ierror.NE.0) THEN c c ----- Bad, non-integer, input c IF (ierror.GT.0) CALL ERRTST (ierror,j) WRITE (*,400) 7,7 400 FORMAT (1X,2A1,'*** Error in input. ***') ELSEIF ((cdataset.GT.dataset).OR.(cdataset.LT.0)) THEN c c ----- Invalid integer input c WRITE (*,401) 7,7,cdataset 401 FORMAT (1X,2A1,'*** Error in input. ',I4,' is not valid. ***') GOTO 6 ENDIF 5 CONTINUE c c ----- Toggle the dataset logical and do the appropriate action c IF (cdataset.EQ.0) GOTO 8 fits(ians,cdataset)=.NOT.fits(ians,cdataset) IF (fits(ians,cdataset)) THEN IF (ians.EQ.1) THEN ok=.TRUE. ELSEIF (ians.EQ.2) THEN CALL SplineCalc (xstart(cdataset,1)-1,xstart(cdataset,2), * f1,f2,cdataset,ok) ELSEIF (ians.EQ.3) THEN CALL BezierCalc (xstart(cdataset,1)-1,xstart(cdataset,2),f1, * f2,cdataset,ok) ELSEIF (ians.EQ.4) THEN CALL FourierCalc (xstart(cdataset,1)-1,xstart(cdataset,2),f1, * f2,cdataset,ok) ELSEIF (ians.EQ.5) THEN CALL PolynomialCalc (xstart(cdataset,1)-1,xstart(cdataset,2), * f1,f2,cdataset,ok) ENDIF fits(ians,cdataset)=ok ENDIF c c ----- Inform user of result c IF (fits(ians,cdataset)) THEN WRITE (*,500) cdataset,' is now ON' ELSE WRITE (*,500) cdataset,' is now OFF' ENDIF 500 FORMAT (' Dataset #',I2,(A)) 6 CONTINUE c c ----- Find first numeric character in input string from current position c ch=datain(ind:ind) IF ((ch.GE.'0').AND.(ch.LE.'9')) GOTO 7 ind=ind+1 IF (ind.GE.last) GOTO 8 GOTO 6 7 CONTINUE c c ----- When first numeric character is found, look for a non-numeric c character (a delimiter - i.e. NOT one of 0..9,+,-) c ind=ind+1 IF (ind.GE.last) GOTO 8 ch=datain(ind:ind) IF (((ch.GE.'0').AND.(ch.LE.'9')).OR.(ch.EQ.'-').OR.(ch.EQ.'+')) * GOTO 7 ind=ind+1 IF (ind.GE.last) GOTO 8 GOTO 4 8 CONTINUE quit=cdataset.EQ.0 RETURN END c c------------------------------------------------------------------------------- c FUNCTION ChooseDataSet (datain,dataset,ok) c INTEGER ChooseDataSet,dataset,ierror,idummy CHARACTER datain*2 LOGICAL ok c READ (datain,*,IOSTAT=ierror) idummy ok=ierror.LE.0 IF (.NOT.ok) THEN WRITE (*,'(1X,2A1,(A))') 7,7,'*** Error in input ***' RETURN ENDIF IF (idummy.EQ.0) THEN ChooseDataSet=dataset ELSE ChooseDataSet=idummy ENDIF RETURN END c c ---------------------------------------------------------------------- c FUNCTION UpCase (ch) c c ----- This function works on ASCII machines. EBCDIC is a ? c CHARACTER*1 UpCase,ch c IF ((ch.GE.'a').AND.(ch.LE.'z')) THEN Upcase=CHAR(ICHAR(ch)-ICHAR('a')+ICHAR('A')) ELSE UpCase=ch ENDIF RETURN END c c ------------------------------------------------------------------------------ c FUNCTION StrLen (string) c c ----- Returns the real length of the string, not the amount of memory set c aside for it. c INTEGER StrLen,i,ilength CHARACTER string*(*) c ilength=LEN(string) StrLen=0 DO i=ilength,1,-1 IF (string(i:i).NE.' ') THEN StrLen=i RETURN ENDIF ENDDO RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE Menu (ans,fits,dataset,xlog,ylog,flip,labels,points, * linestyle,x1,x2,y1,y2,f1,f2) c c ----- The main menu screen with all of the current plot settings for c the current data c INTEGER maxpoints,spoly,ncoeff,maxdataset,dataset,ma,i,j PARAMETER (maxpoints=20000,ncoeff=10,maxdataset=30, * spoly=8*maxpoints) REAL xp(spoly),yp(spoly),coeff(ncoeff,2),x1,x2,y1,y2, * f1,f2 INTEGER power(ncoeff),maxply(maxdataset) CHARACTER*1 ans,UpCase CHARACTER*34 plotted(5),dummy LOGICAL fits(5,maxdataset),xlog,ylog,flip,labels,points, * linestyle c COMMON /PlyDat/xp,yp,coeff,power,maxply,ma c WRITE (*,100) 100 FORMAT ('0',24X,'CurveFit - Main Menu'/) DO 2 i=1,5 dummy='[ ]' DO 1 j=1,dataset dummy(j+2:j+2)='-' IF (fits(i,j)) dummy(j+2:j+2)='+' 1 CONTINUE plotted(i)=dummy 2 CONTINUE WRITE (*,93) '(1) Connect points with straight line ',plotted(1) WRITE (*,93) '(2) Connect points with cubic spline ',plotted(2) WRITE (*,93) '(3) Smooth data with Bezier polynomial',plotted(3) WRITE (*,93) '(4) Smooth data with Fourier transform',plotted(4) WRITE (*,93) '(5) Best fit polynomial ',plotted(5) IF (xlog.AND.ylog) THEN WRITE (*,97) '(6) Logarithms of x or y data','[ XY ]' ELSE IF (xlog) THEN WRITE (*,97) '(6) Logarithms of x or y data','[ X ]' ELSE IF (ylog) THEN WRITE (*,97) '(6) Logarithms of x or y data','[ Y ]' ELSE WRITE (*,97) '(6) Logarithms of x or y data','[ NONE ]' ENDIF WRITE (*,94) '(7) Plotting range of x coordinate [', * x1,' to ',x2,' ]' WRITE (*,94) '(8) Plotting range of y coordinate [', * y1,' to ',y2,' ]' WRITE (*,94) '(9) Fitting range of x coordinate [', * f1,' to ',f2,' ]' IF (flip) THEN WRITE (*,95) '(F) Flip the x and y axes','[ ON ]' ELSE WRITE (*,95) '(F) Flip the x and y axes','[ OFF ]' ENDIF IF (points) THEN WRITE (*,98) '(D) Data points are plotted','[ ON ]' ELSE WRITE (*,98) '(D) Data points are plotted','[ OFF ]' ENDIF IF (labels) THEN WRITE (*,99) '(T) Labels and title placed on the plot','[ ON ]' ELSE WRITE (*,99) '(T) Labels and title placed on the plot', * '[ OFF ]' ENDIF WRITE (*,92) '(A) Add a data file to existing plot','[ ',dataset, * ' ]' IF (linestyle) THEN WRITE (*,96) '(L) User/System defined plotted line styles', * '[ USER ]' ELSE WRITE (*,96) '(L) User/System defined plotted line styles', * '[ SYSTEM ]' ENDIF WRITE (*,101) 101 FORMAT (1X,'(S) Scale/Slide/Subtract a particular dataset'/1X, * '(H) Send plot to disk for hardcopy'/1X, * '(V) Select a new video display device'/1X, * '(N) New data file and plot'/1X,'(E,Q,X) Exit CurveFit', * //10X,'Choose one of the above [Plot to screen]: ',$) READ (*,'(A)') ans ans=UpCase(ans) 92 FORMAT (1X,(A),17X,(A),I,(A)) 93 FORMAT (1X,(A),3X,(A)) 94 FORMAT (1X,(A),E10.3,A4,E10.3,A2) 95 FORMAT (1X,(A),28X,(A)) 96 FORMAT (1X,(A),10X,(A)) 97 FORMAT (1X,(A),24X,(A)) 98 FORMAT (1X,(A),26X,(A)) 99 FORMAT (1X,(A),14X,(A)) RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE Plot (xstart,x1,x2,y1,y2,f1,f2,xlabel,ylabel,title, * labels,points,device,fits,dataset,hard,totalpoints,styles, * linestyle) c c ----- The general plotting subroutine c INTEGER maxpoints,s2,ncoeff,maxdataset,dataset,i,j,ma, * totalpoints,symbol,offset PARAMETER (maxpoints=20000,s2=8*maxpoints,ncoeff=10, * maxdataset=30) REAL x(maxpoints),y(maxpoints),coeff(ncoeff,2), * xbez(s2),ybez(s2),xspl(s2),x1,x2,y1,y2, * yspl(s2),xfr(maxpoints),xplot(s2),yplot(s2),f1,f2, * yfr(maxpoints),xpoly(s2),ypoly(s2) INTEGER power(ncoeff),plotsym(maxdataset),xstart(maxdataset,2), * styles(maxdataset,3),maxply(maxdataset),maxbez(maxdataset), * maxfr(maxdataset),maxspl(maxdataset) CHARACTER xlabel*(*),ylabel*(*),title*(*),device*3,ans*1, * plotname*25,UpCase*1,blank*40 LOGICAL fits(5,maxdataset),labels,hard,points,linestyle c DATA plotsym/3,11,6,7,12,4,16,17,2,5,13,14,15,18,10,3,11,6,7,12, * 4,16,17,2,5,13,14,15,18,10/ DATA blank/'+ '/ c c ----- These are the PGPlot plot symbols, appearing in the following c (default) order (twice to cover the 30 possible data sets): c asterisk, diamond, square, triangle, star, circle, c filled square, filled circle, plus, times, filled triangle, c open cross, star of David, filled star, rounded square c COMMON /XYDat/x,y,/SplDat/xspl,yspl,maxspl COMMON /BezDat/xbez,ybez,maxbez,/FrDat/xfr,yfr,maxfr COMMON /PlyDat/xpoly,ypoly,coeff,power,maxply,ma c IF (hard) THEN WRITE (*,'((A),$)') '0Enter plot file name : ' READ (*,'((A))') plotname CALL PGBegin (0,plotname//device,1,1) ELSE CALL PGBegin (0,device,1,1) ENDIF CALL PGSCH (1.0) CALL PGSCF (2) IF (hard) CALL PGSLW (2) CALL PGEnv (x1,x2,y1,y2,0,1) DO 8 i=1,dataset offset=xstart(i,1)-1 symbol=styles(i,3) IF (symbol.EQ.-1) GOTO 2 IF (symbol.EQ.0) symbol=plotsym(i) DO 1 j=1,xstart(i,2) xplot(j)=x(offset+j) yplot(j)=y(offset+j) 1 CONTINUE CALL PGSCH (MAX(0.5,1.0-0.1*(totalpoints/200))) IF (hard) THEN CALL PGSLW (2) IF (points) CALL PGPoint (xstart(i,2),xplot,yplot,symbol) IF (i.EQ.1) THEN CALL PGSLW (1) CALL PGSCH (1.0) c CALL PGIden ENDIF ELSE CALL PGSLW (1) CALL PGSCH (MAX(0.5,1.0-0.1*(totalpoints/200))) IF (points) CALL PGPoint (xstart(i,2),xplot,yplot,symbol) ENDIF 2 CONTINUE CALL PGSCH (1.0) CALL PGSLS (styles(i,1)) CALL PGSLW (styles(i,2)) IF (fits(1,i)) THEN DO 3 j=1,xstart(i,2) xplot(j)=x(offset+j) yplot(j)=y(offset+j) 3 CONTINUE CALL PGLine (xstart(i,2),xplot,yplot) ENDIF IF (fits(2,i)) THEN DO 4 j=1,maxspl(i) xplot(j)=xspl(8*offset+j) yplot(j)=yspl(8*offset+j) 4 CONTINUE CALL PGLine (maxspl(i),xplot,yplot) ENDIF IF (fits(3,i)) THEN DO 5 j=1,maxbez(i) xplot(j)=xbez(8*offset+j) yplot(j)=ybez(8*offset+j) 5 CONTINUE CALL PGLine (maxbez(i),xplot,yplot) ENDIF IF (fits(4,i)) THEN DO 6 j=1,maxfr(i) xplot(j)=xfr(offset+j) yplot(j)=yfr(offset+j) 6 CONTINUE CALL PGLine (maxfr(i),xplot,yplot) ENDIF IF (fits(5,i)) THEN DO 7 j=1,maxply(i) xplot(j)=xpoly(8*offset+j) yplot(j)=ypoly(8*offset+j) 7 CONTINUE CALL PGLine (maxply(i),xplot,yplot) ENDIF 8 CONTINUE IF (.NOT.hard) THEN WRITE (*,800) 7,'Press T for titles, to quit: ' 800 FORMAT (1X,A1,(A),$) READ (*,'((A))') ans IF (UpCase(ans).NE.'T') GOTO 9 ENDIF WRITE (*,'((A))') blank CALL PGSCH (1.0) CALL PGSCF (2) IF (hard) CALL PGSLW (2) IF (labels) CALL PGLabel (xlabel,ylabel,title) IF (.NOT.hard) THEN WRITE (*,800) 7,'Finished plotting - press to '// * 'continue: ' READ (*,'((A))') ans c c ----- The following is done to clear the screen after the plot is c finished, i.e. when the main menu appears again, on some strange c terminals, like the LANPAR Vision II (VT240 clone). c 9 CONTINUE CALL PGAsk (.FALSE.) CALL PGAdvance ENDIF CALL PGEnd c c ----- For Tektronics emulators, recall plot routines to return to text mode c IF (device.EQ.'/te') THEN ans=CHAR(27) WRITE (*,'(A6)') ans//'[?38l' ENDIF RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c c ----- The above options statement allows the use of this routine with c more than 140 data points, due to N! problems just before label 3. c SUBROUTINE BezierCalc (offset,numpt,f1,f2,dataset,ok) c c ----- The routine for calculating the Bezier polynomial over the c x-coordinate range from F1 to F2. The routine is translated exactly c from Borland's TURBO Graphix Toolbox. The polynomial will space an c additional 7 points {xp,yp} between every two data points {x,y}, c i.e. 8 times as dense. c INTEGER maxpoints,s2,maxdataset,dataset,numpt,i,j,maxcpt, * intpt,n,maxpointset,offset,maxnum PARAMETER (maxpoints=20000,s2=8*maxpoints,maxdataset=30, * maxpointset=2000) INTEGER maxbez(maxdataset) REAL x(maxpoints),y(maxpoints),xp(s2),yp(s2),t,quot,f1,f2, * one,deltat REAL*8 c(0:maxpointset),sumx,sumy,done,prod LOGICAL ok c DATA one,done/1.0,1.0D0/ c COMMON /XYDat/x,y,/BezDat/xp,yp,maxbez c ok=.FALSE. i=0 1 CONTINUE i=i+1 IF (x(offset+i).LT.f1) GOTO 1 j=i 2 CONTINUE IF (j+1.LE.numpt.AND.x(offset+j+1).LE.f2) THEN j=j+1 GOTO 2 ENDIF maxcpt=j-i maxnum=(j-i+1)*8 maxbez(dataset)=maxnum IF (maxcpt.LT.2) THEN WRITE (*,'(1X,A1,(A))') 7,'Error in Bezier Calculation routine!' RETURN ENDIF f1=x(offset+i) f2=x(offset+j) IF (f1.GT.f2) CALL Swap (f1,f2) deltat=one/(maxnum-1) c(0)=done c(maxcpt)=done DO 3 n=0,maxcpt-2 c(n+1)=c(n)*(maxcpt-n)/(n+1) 3 CONTINUE DO 8 intpt=1,maxnum t=(intpt-1)*deltat IF (t.LE.0.5) THEN quot=one-t prod=quot DO 4 n=1,maxcpt-1 prod=prod*quot 4 CONTINUE quot=t/quot sumx=x(offset+j) sumy=y(offset+j) DO 5 n=maxcpt,1,-1 sumx=c(n-1)*x(offset+i+n-1)+quot*sumx sumy=c(n-1)*y(offset+i+n-1)+quot*sumy 5 CONTINUE ELSE quot=t prod=quot DO 6 n=1,maxcpt-1 prod=prod*quot 6 CONTINUE quot=(one-t)/quot sumx=x(offset+i) sumy=y(offset+i) DO 7 n=1,maxcpt sumx=c(n)*x(offset+i+n)+quot*sumx sumy=c(n)*y(offset+i+n)+quot*sumy 7 CONTINUE ENDIF xp(8*offset+intpt)=SNGL(sumx*prod) yp(8*offset+intpt)=SNGL(sumy*prod) 8 CONTINUE ok=.TRUE. RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE PolynomialCalc (offset,numpt,f1,f2,dataset,ok) c c ----- Calculate the best fit polynomial over the x-coordinate range c F1 to F2. The routine used is called Singular Value Decomposition c (SVDFIT), taken from the book Numerical Recipes by W.H. Press et al. c It is slower than normal solving of the matrices involved, but will c never give an infinite coefficient. Coefficients that tend toward c infinity while cancelling another are set to zero with this method. c Other negligible coefficients are also set to zero (determined by c the size of TOL*WMAX). The best fit is done with a polynomial of c user specified order, though the number of non-zero coefficients must c be less than 10. This routine also returns the error in the c coefficients and data points to plot. It is assumed that no c uncertainties exist in the input data. c INTEGER maxpoints,s2,ncoeff,maxdataset,dataset,ma,i,j,k, * numpt,maxpointset,offset,maxnum,ierror CHARACTER ans*1 PARAMETER (maxpoints=20000,s2=8*maxpoints,maxdataset=30, * ncoeff=10,maxpointset=2000) REAL x(maxpoints),y(maxpoints),coeff(ncoeff,2), * xpoly(s2),ypoly(s2),tol,zero,f1,f2,const,xp,FPoly REAL*8 v(ncoeff,ncoeff),u(maxpointset,ncoeff),w(ncoeff), * wmax,thresh INTEGER power(ncoeff),maxply(maxdataset) LOGICAL ok c COMMON /XYDat/x,y,/PlyDat/xpoly,ypoly,coeff,power,maxply,ma c DATA tol,zero/1.0E-10,0.0/ c ok=.FALSE. i=0 1 CONTINUE i=i+1 IF (x(offset+i).LT.f1) GOTO 1 j=i 2 CONTINUE IF (j+1.LE.numpt.AND.x(offset+j+1).LE.f2) THEN j=j+1 GOTO 2 ENDIF maxnum=j-i+1 IF (maxnum.LT.2) THEN WRITE (*,'(1X,A1,(A),(A))') 7,'Error in Polynomial Calculation', * ' routine!' RETURN ENDIF f1=x(offset+i) f2=x(offset+j) IF (f1.GT.f2) CALL Swap (f1,f2) c c ----- Enter the user chosen non-zero coefficients. The data will c be fit only to these powers of the polynomial. c WRITE (*,100) 100 FORMAT (' Enter the power of any coefficient that is to be ', * 'included in the fit.'/' (^Z to finish)'//2X, * 'ex. Best-fit to a cubic, enter'/5X,'0 1 2 3^Z'//) ma=0 DO 3 j=1,ncoeff coeff(j,1)=zero coeff(j,2)=zero power(j)=1000 3 CONTINUE WRITE (*,'(1X,(A),$)') 'Power(s) : ' READ (*,*,ERR=1000,END=4,IOSTAT=ierror) (power(k),k=1,ncoeff) 4 CONTINUE CALL PowerSort (power,k,ma,ncoeff) DO 6 j=1,maxnum xp=x(offset+i+j-1) DO 5 k=1,ma IF (xp.EQ.zero) THEN u(j,k)=zero ELSE u(j,k)=xp**power(k) ENDIF 5 CONTINUE ypoly(8*offset+j)=y(offset+i+j-1) 6 CONTINUE CALL SVDCMP (u,maxnum,ma,ncoeff,w,v) wmax=zero DO 7 j=1,ma wmax=MAX(wmax,w(j)) 7 CONTINUE thresh=tol*wmax DO 8 j=1,ma IF (w(j).LT.thresh) w(j)=zero 8 CONTINUE CALL SVBKSB (u,w,v,maxnum,ma,ncoeff,ypoly,dataset,coeff,8*offset) CALL SVDVar (v,ma,ncoeff,w,coeff) maxply(dataset)=10*maxnum const=(f2-f1)/(maxply(dataset)-1) DO 9 j=1,maxply(dataset) xpoly(8*offset+j)=const*(j-1)+f1 ypoly(8*offset+j)=FPoly(xpoly(8*offset+j),coeff,power,ma) 9 CONTINUE ok=.TRUE. WRITE (*,101) 101 FORMAT ('0The calculated coefficients are : '//) DO 10 i=1,ma,2 IF (i+1.LE.ma) THEN WRITE (*,102) power(i),coeff(i,1),coeff(i,2), * power(i+1),coeff(i+1,1),abs(coeff(i+1,2)) 102 FORMAT (2(7X,'x^',I3,4X,E12.5,' +- ',E9.3)) ELSE WRITE (*,103) power(i),coeff(i,1),abs(coeff(i,2)) 103 FORMAT (7X,'x^',I3,4X,E12.5,' +- ',E9.3) ENDIF 10 CONTINUE WRITE (*,104) 104 FORMAT ('0Press to continue ',$) 11 CONTINUE READ (*,'((A))') ans RETURN c c ----- Error checking/error flag resetting routine. c 1000 CONTINUE IF (ierror.GT.0) CALL ERRTST (ierror,j) WRITE (*,105) 7,7,'*** Error in input - redo! ***' 105 FORMAT ('0',2A1,(A)) GOTO 3 END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c c ----- This was added to help reduce problems with large powers and x c very small or very large. c FUNCTION FPoly (x,coeff,power,ma) c c ----- This calculates the polynomial at a point x. If x=0, then the c polynomial is set to the constant, coeff(0), instead of to a c possible infinity. This is needed by the routine PolynomialCalc. c INTEGER ncoeff,m,ma,i REAL*8 sum,zero,xp PARAMETER (ncoeff=10) REAL coeff(ncoeff,2),FPoly,x INTEGER power(ncoeff) c DATA zero/0.0D0/ c xp=DBLE(x) IF (xp.NE.zero) THEN sum=zero DO 1 i=1,ma sum=sum+DBLE(coeff(i,1))*(xp**power(i)) 1 CONTINUE c c ----- The following idiot-proofing is made to avoid over- and c underflows. Of course, it could still happen in the previous c step if x is too large or too small. c IF (sum.EQ.zero) THEN FPoly=0.0 ELSE IF (DLOG10(DABS(sum)).GT.38) THEN FPoly=1.0E30 ELSE IF (DLOG10(DABS(sum)).LT.-38) THEN FPoly=0.0 ELSE FPoly=SNGL(sum) ENDIF ELSE m=0 2 CONTINUE m=m+1 IF ((power(m).NE.0).AND.(m.LE.ma)) GOTO 2 IF (m.GT.ma) THEN FPoly=0.0 ELSE FPoly=coeff(m,1) ENDIF ENDIF RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE PowerSort (power,k,ma,ncoeff) c c ----- This routine is a simple insertion sort. It sorts the vector c POWER into ascending order, counting the number of distinct powers c while eliminating any doubled powers. c INTEGER ncoeff,ma,i,j,k,power(ncoeff),ip c DO 3 i=2,ncoeff ip=power(i) DO 1 j=i-1,1,-1 IF (power(j).LE.ip) GOTO 2 power(j+1)=power(j) 1 CONTINUE j=0 2 CONTINUE power(j+1)=ip 3 CONTINUE DO 6 i=1,ncoeff-1 IF (power(i+1).EQ.1000) GOTO 7 4 CONTINUE IF (power(i).EQ.power(i+1)) THEN DO 5 j=i+1,ncoeff-1 power(j)=power(j+1) 5 CONTINUE GOTO 4 ENDIF 6 CONTINUE 7 CONTINUE ma=i RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE SVDCMP (a,m,n,np,w,v) c c ----- This subroutine is taken exactly from the book Numerical Recipes c by W.H. Press et al., and is used by the routine PolynomialCalc to c do the singular value decomposition (SVD) of the input data matrix. c The results of the SVD can have certain values zeroed to eliminate c them from the resultant coefficients. c INTEGER i,j,k,l,m,n,its,nm,maxpointset,np PARAMETER (maxpointset=2000) REAL*8 a(maxpointset,np),w(np),v(np,np),rv1(maxpointset), * x,y,z,h,c,s,f,g,scale,anorm,zero,one c DATA zero,one/0.0D0,1.0D0/ c g=zero scale=zero anorm=zero DO 25 i=1,n l=i+1 rv1(i)=scale*g g=zero s=zero scale=zero IF (i.LE.m) THEN DO 11 k=i,m scale=scale+ABS(a(k,i)) 11 CONTINUE IF (scale.NE.zero) THEN DO 12 k=i,m a(k,i)=a(k,i)/scale s=s+a(k,i)*a(k,i) 12 CONTINUE f=a(i,i) g=-SIGN(SQRT(s),f) h=f*g-s a(i,i)=f-g IF (i.NE.n) THEN DO 15 j=l,n s=zero DO 13 k=i,m s=s+a(k,i)*a(k,j) 13 CONTINUE f=s/h DO 14 k=i,m a(k,j)=a(k,j)+f*a(k,i) 14 CONTINUE 15 CONTINUE ENDIF DO 16 k=i,m a(k,i)=scale*a(k,i) 16 CONTINUE ENDIF ENDIF w(i)=scale*g g=zero s=zero scale=zero IF ((i.LE.m).AND.(i.NE.n)) THEN DO 17 k=l,n scale=scale+ABS(a(i,k)) 17 CONTINUE IF (scale.NE.zero) THEN DO 18 k=l,n a(i,k)=a(i,k)/scale s=s+a(i,k)*a(i,k) 18 CONTINUE f=a(i,l) g=-SIGN(SQRT(s),f) h=f*g-s a(i,l)=f-g DO 19 k=l,n rv1(k)=a(i,k)/h 19 CONTINUE IF (i.NE.m) THEN DO 23 j=l,m s=zero DO 21 k=l,n s=s+a(j,k)*a(i,k) 21 CONTINUE DO 22 k=l,n a(j,k)=a(j,k)+s*rv1(k) 22 CONTINUE 23 CONTINUE ENDIF DO 24 k=l,n a(i,k)=scale*a(i,k) 24 CONTINUE ENDIF ENDIF anorm=MAX(anorm,(ABS(w(i))+ABS(rv1(i)))) 25 CONTINUE DO 32 i=n,1,-1 IF (i.LT.n) THEN IF (g.NE.zero) THEN DO 26 j=l,n v(j,i)=(a(i,j)/a(i,l))/g 26 CONTINUE DO 29 j=l,n s=zero DO 27 k=l,n s=s+a(i,k)*v(k,j) 27 CONTINUE DO 28 k=l,n v(k,j)=v(k,j)+s*v(k,i) 28 CONTINUE 29 CONTINUE ENDIF DO 31 j=l,n v(i,j)=zero v(j,i)=zero 31 CONTINUE ENDIF v(i,i)=one g=rv1(i) l=i 32 CONTINUE DO 39 i=n,1,-1 l=i+1 g=w(i) IF (i.LT.n) THEN DO 33 j=l,n a(i,j)=zero 33 CONTINUE ENDIF IF (g.NE.zero) THEN g=one/g IF (i.NE.n) THEN DO 36 j=l,n s=zero DO 34 k=l,m s=s+a(k,i)*a(k,j) 34 CONTINUE f=s*g/a(i,i) DO 35 k=i,m a(k,j)=a(k,j)+f*a(k,i) 35 CONTINUE 36 CONTINUE ENDIF DO 37 j=i,m a(j,i)=a(j,i)*g 37 CONTINUE ELSE DO 38 j=i,m a(j,i)=zero 38 CONTINUE ENDIF a(i,i)=a(i,i)+one 39 CONTINUE DO 49 k=n,1,-1 DO 48 its=1,30 DO 41 l=k,1,-1 nm=l-1 IF ((ABS(rv1(l))+anorm).EQ.anorm) GOTO 2 IF ((ABS(w(nm))+anorm).EQ.anorm) GOTO 1 41 CONTINUE 1 c=zero s=one DO 43 i=l,k f=s*rv1(i) IF ((ABS(f)+anorm).NE.anorm) THEN g=w(i) h=SQRT(f*f+g*g) w(i)=h h=one/h c=g*h s=-f*h DO 42 j=1,m y=a(j,nm) z=a(j,i) a(j,nm)=y*c+z*s a(j,i)=-y*s+z*c 42 CONTINUE ENDIF 43 CONTINUE 2 z=w(k) IF (l.EQ.k) THEN IF (z.LT.zero) THEN w(k)=-z DO 44 j=1,n v(j,k)=-v(j,k) 44 CONTINUE ENDIF GOTO 3 ENDIF IF (its.EQ.30) PAUSE 'No convergence in 30 iterations' x=w(l) nm=k-1 y=w(nm) g=rv1(nm) h=rv1(k) f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y) g=SQRT(f*f+one) f=((x-z)*(x+z)+h*(y/(f+SIGN(g,f))-h))/x c=one s=one DO 47 j=l,nm i=j+1 g=rv1(i) y=w(i) h=s*g g=c*g z=SQRT(f*f+h*h) rv1(j)=z c=f/z s=h/z f=x*c+g*s g=-x*s+g*c h=y*s y=y*c DO 45 nm=1,n x=v(nm,j) z=v(nm,i) v(nm,j)=x*c+z*s v(nm,i)=-x*s+z*c 45 CONTINUE z=SQRT(f*f+h*h) w(j)=z IF (z.NE.zero) THEN z=one/z c=f*z s=h*z ENDIF f=c*g+s*y x=-s*g+c*y DO 46 nm=1,m y=a(nm,j) z=a(nm,i) a(nm,j)=y*c+z*s a(nm,i)=-y*s+z*c 46 CONTINUE 47 CONTINUE rv1(l)=zero rv1(k)=f w(k)=x 48 CONTINUE 3 CONTINUE 49 CONTINUE RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE SVBKSB (u,w,v,m,n,np,b,dataset,coeff,offset) c c ----- This subroutine is taken from the book Numerical Recipes by c W.H. Press et al., and is used by the routine PolynomialCalc to c calculate the final solution of the least-squares fit coefficients, c after negligible coefficients have been zeroed. c INTEGER i,j,n,m,np,jj,dataset,maxpointset,s2,maxdataset, * maxpoints,offset PARAMETER (maxpoints=20000,s2=8*maxpoints,maxdataset=30, * maxpointset=2000) REAL*8 u(maxpointset,np),w(np),v(np,np),tmp(maxpointset),zero, * s REAL b(s2),coeff(np,2) c DATA zero/0.0D0/ c DO 2 j=1,n s=zero IF (w(j).NE.zero) THEN DO 1 i=1,m s=s+u(i,j)*b(offset+i) 1 CONTINUE s=s/w(j) ENDIF tmp(j)=s 2 CONTINUE DO 4 j=1,n s=zero DO 3 jj=1,n s=s+v(j,jj)*tmp(jj) 3 CONTINUE coeff(j,1)=s 4 CONTINUE RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE SVDVar (v,m,np,w,stdev) c c ----- A subroutine taken from the book Numerical Recipes by W.H. Press c et al., required by the routine PolynomialCalc to obtain standard c deviations of the least-squares fit coefficients. c INTEGER i,m,np,k,ncoeff PARAMETER (ncoeff=10) REAL*8 v(np,np),w(np),wti(ncoeff),zero,sum REAL stdev(np,2) c DATA zero/0.0D0/ c DO 1 i=1,m wti(i)=zero IF (w(i).NE.zero) wti(i)=1.0/w(i)/w(i) 1 CONTINUE DO 3 i=1,m sum=zero DO 2 k=1,m sum=sum+v(i,k)*v(i,k)*wti(k) 2 CONTINUE stdev(i,2)=SQRT(sum) 3 CONTINUE RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE FourierCalc (offset,numpt,f1,f2,dataset,ok) c c ----- Calculate the Fourier transform smoothed data from x-coordinate c F1 to F2. The method is paraphrased from the book Numerical Recipes c by W.H. Press et al. The extra size for YFOUR is due to zero padding c out to the next largest power of 2. For larger values for the number c of smoothing points (PTS), the resultant curve will become less c featureless as more high frequency 'noise' is removed. c INTEGER dataset,i,j,k,m,nmin,maxpoints,maxdataset,offset, * numpt,maxnum,ierror,maxpointset PARAMETER (maxpoints=20000,maxpointset=2000,maxdataset=30) INTEGER maxfr(maxdataset) REAL x(maxpoints),y(maxpoints),xfr(maxpoints), * yfr(maxpoints),zero,one,pts,f1,f2,rn1,const,window,yn,y1, * yfour(4*maxpointset) LOGICAL ok c COMMON /XYDat/x,y,/FrDat/xfr,yfr,maxfr c DATA zero,one/0.0,1.0/ c ok=.FALSE. i=0 1 CONTINUE i=i+1 IF (x(offset+i).LT.f1) GOTO 1 j=i 2 CONTINUE IF (j+1.LE.numpt.AND.x(offset+j+1).LE.f2) THEN j=j+1 GOTO 2 ENDIF maxnum=j-i+1 maxfr(dataset)=maxnum IF (maxnum.LT.2) THEN WRITE (*,'(1X,A1,(A),(A))') 7,'Error in Fourier Calculation', * ' routine!' RETURN ENDIF f1=x(offset+i) f2=x(offset+j) IF (f1.GT.f2) CALL Swap (f1,f2) DO 3 k=0,maxnum-1 yfour(2*k+1)=y(offset+i+k) yfour(2*k+2)=zero xfr(offset+k+1)=x(offset+i+k) 3 CONTINUE WRITE (*,'(''0'',(A),I4,(A),I3,(A),$)') 'Number of smoothing '// * 'points to use [ n <',maxnum,' - ',maxnum/10,' is good ]: ' READ (*,*,ERR=1000,IOSTAT=ierror) pts IF (pts.GE.maxnum) THEN WRITE (*,'(1X,A1,(A),(A),I3)') 7,'Error in input - number of ', * 'points must be less than ',maxnum GOTO 3 ENDIF nmin=maxnum+2.0*pts m=2 4 IF (m.LE.nmin) THEN m=2*m GOTO 4 ENDIF const=pts/m*pts/m y1=yfour(1) yn=yfour(2*maxnum-1) rn1=one/(maxnum-one) DO 5 j=1,maxnum yfour(2*j-1)=yfour(2*j-1)-rn1*(y1*(maxnum-j)+yn*(j-1)) 5 CONTINUE DO 6 j=2*maxnum+1,2*m yfour(j)=zero 6 CONTINUE CALL Four1 (yfour,2*m,1) c c ----- The FFT is multiplied by a low band pass filter of characteristic c size PTS. PTS > 2 will eliminate some high frequencies completely. c DO 7 j=1,m/2-1 window=AMAX1(zero,one-const*j*j) k=2*j+1 yfour(k)=yfour(k)*window yfour(k+1)=yfour(k+1)*window k=2*(m-j)+1 yfour(k)=yfour(k)*window yfour(k+1)=yfour(k+1)*window 7 CONTINUE yfour(m+1)=zero yfour(m+2)=zero CALL Four1 (yfour,2*m,-1) DO 8 j=1,maxnum yfr(offset+j)=yfour(2*j-1)/m+rn1*(y1*(maxnum-j)+yn*(j-1)) 8 CONTINUE ok=.TRUE. RETURN c c ----- Error checking/error flag resetting routine. c 1000 CONTINUE IF (ierror.GT.0) CALL ERRTST (ierror,j) WRITE (*,100) 7,7,'*** Error in input - redo! ***' 100 FORMAT ('0',2A1,(A)) GOTO 3 END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE Four1 (data,nn,isign) c c ----- A FFT subroutine needed for the subroutine FourierCalc. This c routine is taken exactly from the book Numerical Recipes by c W.H. Press et al. c REAL*8 wr,wi,wpr,wpi,wtemp,theta,twopi,two INTEGER nn,isign,j,n,i,istep,mmax,m REAL data(nn),tempi,tempr c DATA two,twopi/2.0D0,6.28318530717958647692D0/ c n=nn j=1 DO 2 i=1,n,2 IF (j.GT.i) THEN tempr=data(j) tempi=data(j+1) data(j)=data(i) data(j+1)=data(i+1) data(i)=tempr data(i+1)=tempi ENDIF m=n/2 1 IF ((m.ge.2).AND.(j.GT.m)) THEN j=j-m m=m/2 GOTO 1 ENDIF j=j+m 2 CONTINUE mmax=2 3 IF (n.GT.mmax) THEN istep=2*mmax theta=twopi*isign*mmax wpr=-two*DSIN(theta/two)**2 wpi=DSIN(theta) wr=1.0D0 wi=0.0D0 DO 5 m=1,mmax,2 DO 4 i=m,n,istep j=i+mmax tempr=SNGL(wr)*data(j)-SNGL(wi)*data(j+1) tempi=SNGL(wr)*data(j+1)+SNGL(wi)*data(j) data(j)=data(i)-tempr data(j+1)=data(i+1)-tempi data(i)=data(i)+tempr data(i+1)=data(i+1)+tempi 4 CONTINUE wtemp=wr wr=wr*wpr-wi*wpi+wr wi=wi*wpr+wtemp*wpi+wi 5 CONTINUE mmax=istep GOTO 3 ENDIF RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE SplineCalc (offset,numpt,f1,f2,dataset,ok) c c ----- Calculates the cubic spline fit from x-coordinates F1 to F2. c The routine algorithm is derived from Borland's TURBO Graphix c Toolbox along with the equations given in Numerical Recipes by c W.H. Press et al. c INTEGER dataset,n,j,i,k,maxpoints,s2,maxdataset,offset,numpt, * maxnum,maxpointset PARAMETER (maxpoints=20000,s2=8*maxpoints,maxdataset=30, * maxpointset=2000) INTEGER maxspl(maxdataset) REAL x(maxpoints),y(maxpoints),xp(maxpointset),Spline2, * yp(maxpointset),y2prime(maxpoints),xspl(s2),yspl(s2),f1,f2, * deltax LOGICAL ok c COMMON /XYDat/x,y,/SplDat/xspl,yspl,maxspl c ok=.TRUE. i=0 1 CONTINUE i=i+1 IF (x(offset+i).LT.f1) GOTO 1 j=i 2 CONTINUE IF (j+1.LE.numpt.AND.x(offset+j+1).LE.f2) THEN j=j+1 GOTO 2 ENDIF n=j-i+1 IF (n.LT.2) THEN WRITE (*,'(1X,A1,(A))') 7,'Error in Spline Calculation routine!' ok=.FALSE. RETURN ENDIF f1=x(offset+i) f2=x(offset+j) IF (f1.GT.f2) CALL Swap (f1,f2) maxnum=8*n maxspl(dataset)=maxnum DO 3 k=1,n xp(k)=x(offset+i+k-1) yp(k)=y(offset+i+k-1) 3 CONTINUE CALL Spline1 (xp,yp,y2prime,n) deltax=(f2-f1)/(maxnum-1) DO 4 k=1,maxnum-1 xspl(8*offset+k)=f1+(k-1)*deltax 4 CONTINUE xspl(8*offset+maxnum)=f2 DO 5 k=1,maxnum yspl(8*offset+k)=Spline2(xspl(8*offset+k),xp,yp,y2prime,n) 5 CONTINUE RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c SUBROUTINE Spline1 (x,y,y2prime,n) c c ----- A subroutine needed for the cubic spline calculations. It is c an algorithm derived from the cubic spline equations given in c Numerical Recipes by W.H. Press et al. The boundary condition c of zero first derivative at the endpoints is assumed here. c INTEGER n,i,maxpointset PARAMETER (maxpointset=2000) REAL x(n),y(n),y2prime(n) REAL*8 a(2:maxpointset),b(2:maxpointset-1),dummy(maxpointset) c a(2)=DBLE(x(2))-x(1) a(3)=DBLE(x(3))-x(2) b(2)=2.0D0*(DBLE(x(3))-x(1))+a(2)/2.0D0 dummy(2)=6.0D0*(DBLE(y(3))-y(2))/a(3)-3.0D0*(DBLE(y(2))-y(1))/a(2) DO 1 i=3,n-1 a(i+1)=DBLE(x(i+1))-x(i) b(i)=2.0D0*(DBLE(x(i+1))-x(i-1))-a(i)*a(i)/b(i-1) dummy(i)=6.0D0*((DBLE(y(i+1))-y(i))/a(i+1)- * (DBLE(y(i))-y(i-1))/a(i))-a(i)*dummy(i-1)/b(i-1) 1 CONTINUE dummy(n)=(dummy(n-1)/b(n-1)-6.0D0*(DBLE(y(n))-y(n-1))/a(n)/a(n))/ * (2.0D0+a(n)/b(n-1)) DO 2 i=n-1,2,-1 dummy(i)=(dummy(i)-a(i+1)*dummy(i+1))/b(i) 2 CONTINUE dummy(1)=dummy(2)*0.5D0-3.0D0*(DBLE(y(2))-y(1))/a(2)/a(2) DO 3 i=1,n y2prime(i)=SNGL(dummy(i)) 3 CONTINUE RETURN END c c------------------------------------------------------------------------------- c OPTIONS /G_FLOATING c FUNCTION Spline2 (x,xp,yp,y2prime,n) c c ----- A subroutine needed for the cubic spline calculations. It is c an algorithm derived from the eqautions given in Numerical Recipes c by W.H. Press et al. c INTEGER n,j REAL xp(n),yp(n),y2prime(n),x,Spline2 REAL*8 dx,a,b,c,d c IF (x.LE.xp(1)) THEN Spline2=yp(1) ELSE IF (x.GE.xp(n)) THEN Spline2=yp(n) ELSE j=1 1 CONTINUE IF ((x.GT.xp(j)).AND.(x.LE.xp(j+1))) GOTO 2 j=j+1 GOTO 1 2 CONTINUE dx=DBLE(xp(j+1))-xp(j) a=(DBLE(xp(j+1))-x)/dx b=1.0D0-a c=(a*a*a-a)*dx*dx/6.0D0 d=(b*b*b-b)*dx*dx/6.0D0 Spline2=a*yp(j)+b*yp(j+1)+c*y2prime(j)+d*y2prime(j+1) ENDIF RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE ReadData (dataset,xstart,x1,y1,x2,y2,fileopen, * totalpoints) c c ----- This subroutine reads in all data files, sets the plotting limits, c and counts the number of points read in. ReadData asks if more data is c to be read from the current open data file. If not, it will prompt for c a filename until a correct one is entered. ReadData then prompts for the c number of lines to skip from the current position in the file, c where N >= 0 simply skips that number of lines and reads the data, c N = -1 reads a line, prints it, and confirms the skip, c N < -1 skips ABS(N) lines and prompts again for lines to skip, c 'Bn' backs up n line(s) (not case-sensitive!). c Finally, the data is read in, after prompting for the columns for the c (x,y) input. Up to 25 columns are accessible from a single data file. c A data set ends when a non-numeric line is run into, or the file ends. c INTEGER maxpoints,maxdataset,dataset,ierror,i,j,xcol,ycol, * lineskip,totalpoints,maxcolumn,ii,offset,maxcol,maxpointset, * linesread,StrLen PARAMETER (maxpoints=20000,maxdataset=30,maxpointset=2000, * maxcolumn=25) REAL xdata(maxpointset),ydata(maxpointset),x(maxpoints), * y(maxpoints),x1,x2,y1,y2,one,zero,data(maxcolumn), * xminmax(2,maxdataset),yminmax(2,maxdataset) INTEGER xstart(maxdataset,2) CHARACTER fname*40,blank*40,ans*1,linein*500,UpCase*1,longans*6 LOGICAL fileopen c DATA blank/' '/ DATA zero,one/0.0,1.0/ SAVE fname,linesread COMMON /XYDat/x,y,xdata,ydata,xminmax,yminmax c 1 CONTINUE IF (fileopen) THEN WRITE (*,*) WRITE (*,98) 'More data from the same file [y] ? ' READ (*,97) ans IF (UpCase(ans).EQ.'N') THEN CLOSE (10) fileopen=.FALSE. linesread=0 ENDIF ENDIF IF (.NOT.fileopen) THEN WRITE (*,*) WRITE (*,98) 'Input the full name of the data file '// * '(^Z to quit): ' 2 CONTINUE fname=blank READ (*,97,END=11) fname OPEN (UNIT=10,FILE=fname,STATUS='old',IOSTAT=ierror) IF (ierror.NE.0) THEN WRITE (*,'(A1,A20,(A))') 7,' Error opening file ',fname WRITE (*,*) WRITE (*,98) 'Input the correct data file name: ' GOTO 2 ENDIF fileopen=.TRUE. linesread=0 ENDIF ii=1 3 CONTINUE WRITE (*,300) 300 FORMAT ('0Skip n lines before data is read'/,' (n=-1, show ', * 'each line and confirm skip -- n<-1, skip ABS(n) lines ', * 'and prompt)'/,' (Bn, go backwards n lines and prompt --', * ' otherwise skip n lines and continue on)') WRITE (*,98) 'Skip how many lines ? ' READ (*,97) longans ans=UpCase(longans(1:1)) IF (ans.EQ.'B') THEN READ (longans(2:6),*,ERR=1000,END=33,IOSTAT=ierror) lineskip IF (lineskip.LE.1) lineskip=1 33 CONTINUE REWIND (10,ERR=3) linesread=MAX(linesread-lineskip-1,0) DO 34 i=1,linesread READ (10,*) 34 CONTINUE GOTO 3 ELSE IF (ans.EQ.' ') GOTO 3 READ (longans,*,ERR=1000,IOSTAT=ierror) lineskip ENDIF IF (lineskip.EQ.-1) THEN 4 CONTINUE READ (10,97,END=55) linein linesread=linesread+1 WRITE (*,*) linein(1:StrLen(linein)) WRITE (*,98) 'Skip line (Bn = n lines backwards) [y] ? ' READ (*,97) longans ans=UpCase(longans) IF (ans.EQ.'B') THEN READ (longans(2:6),*,ERR=465,END=465,IOSTAT=ierror) lineskip IF (lineskip.LE.1) lineskip=1 465 CONTINUE IF (ierror.GT.0) CALL ERRTST (ierror,j) linesread=MAX(linesread-lineskip-1,0) REWIND (10) DO 47 i=1,linesread READ (10,*) 47 CONTINUE 48 CONTINUE GOTO 4 ENDIF IF (ans.NE.'N') GOTO 4 BACKSPACE 10 linesread=linesread-1 ELSE DO 5 i=1,ABS(lineskip) READ (10,*,END=55) 5 CONTINUE linesread=linesread+ABS(lineskip) IF (lineskip.LT.0) GOTO 3 GOTO 6 55 CONTINUE i=0 GOTO 8 ENDIF 6 CONTINUE ii=2 WRITE (*,*) WRITE (*,98) 'Choose the columns for the x,y data (1 - 25): ' READ (*,*,ERR=1000,IOSTAT=ierror) xcol,ycol maxcol=MAX(xcol,ycol) IF ((maxcol.GT.maxcolumn).OR.(xcol.EQ.ycol)) GOTO 6 ii=3 DO 7 i=1,MIN(maxpoints-totalpoints,maxpointset) linesread=linesread+1 READ (10,97,ERR=1000,END=8,IOSTAT=ierror) linein READ (linein,*,ERR=1000,END=65,IOSTAT=ierror) * (data(j),j=1,maxcol) xdata(i)=data(xcol) ydata(i)=data(ycol) GOTO 7 65 CONTINUE WRITE (*,96) 7,7,'*** ERROR - Incorrect number of '// * 'columns - Re-enter requested columns ***' IF (i.EQ.1) GOTO 66 WRITE (*,*) 'Input line number: ',linesread WRITE (*,*) linein WRITE (*,98) 'Ignore error - continue on [n] ?: ' READ (*,97) ans IF (UpCase(ans).EQ.'Y') GOTO 7 66 CONTINUE BACKSPACE (10) linesread=linesread-1 GOTO 6 7 CONTINUE 8 CONTINUE CLOSE (10) fileopen=.FALSE. linesread=0 9 CONTINUE c c ----- General initialization routines c IF (i-1.LE.0) THEN WRITE (*,96) 7,7,'*** ERROR - No points read from data '// * 'file ***' GOTO 1 ENDIF dataset=dataset+1 IF (dataset.EQ.1) THEN xstart(dataset,1)=1 ELSE xstart(dataset,1)=xstart(dataset-1,1)+xstart(dataset-1,2) ENDIF xstart(dataset,2)=i-1 totalpoints=totalpoints+i-1 WRITE (*,*) i-1,' data points read' xminmax(1,dataset)=1E35 xminmax(2,dataset)=-1E35 yminmax(1,dataset)=1E35 yminmax(2,dataset)=-1E35 offset=xstart(dataset,1)-1 DO 10 i=1,xstart(dataset,2) x(i+offset)=xdata(i) xminmax(1,dataset)=MIN(xminmax(1,dataset),xdata(i)) xminmax(2,dataset)=MAX(xminmax(2,dataset),xdata(i)) x1=MIN(x1,xdata(i)) x2=MAX(x2,xdata(i)) y(i+offset)=ydata(i) yminmax(1,dataset)=MIN(yminmax(1,dataset),ydata(i)) yminmax(2,dataset)=MAX(yminmax(2,dataset),ydata(i)) y1=MIN(y1,ydata(i)) y2=MAX(y2,ydata(i)) 10 CONTINUE CALL SetLimits (x1,x2) CALL SetLimits (y1,y2) 11 CONTINUE IF (.NOT.fileopen) WRITE (*,96) 7,7,'*** No more data in ' * //fname(1:StrLen(fname))//' - file is closed ***' IF (dataset.NE.0) RETURN WRITE (*,98) 'No datasets have been entered. Try [a]gain or'// * ' [s]top [A]: ' READ (*,97) ans IF (UpCase(ans).NE.'S') GOTO 1 STOP 96 FORMAT ('0',2A1,(A)) 97 FORMAT ((A)) 98 FORMAT (1X,(A),$) c c ----- Error checking/error flag resetting routine. c 1000 CONTINUE IF (ierror.GT.0) CALL ERRTST (ierror,j) IF (ii.EQ.3) THEN GOTO 9 ELSE WRITE (*,97) 7,7,'*** Error in input - redo! ***' GOTO (3,6),ii ENDIF END c c------------------------------------------------------------------------------- c SUBROUTINE SetLimits (lo,hi) c c ----- This subroutine sets the X-Y plotting limits anytime that new c data is input or logs/antilogs are calculated from the data. It c is meant to be accurate to 2 significant figures. c REAL oldlo,oldhi,lo,hi,flo,fhi,zero,one,loglo,loghi, * mantlo,manthi INTEGER ordlo,ordhi LOGICAL neglo,neghi c DATA zero/0.0/,one/1.0/ c oldlo=lo oldhi=hi neglo=(oldlo.LT.zero) neghi=(oldhi.LT.zero) loglo=zero loghi=zero IF (oldlo.NE.zero) THEN loglo=LOG10(ABS(oldlo)) ordlo=INT(loglo) mantlo=loglo-ordlo+one IF (mantlo.LT.one) THEN mantlo=mantlo+one ordlo=ordlo-one ENDIF flo=10.0**mantlo IF (ABS(flo-NINT(flo)).GT.0.1) THEN flo=INT(flo) IF (neglo) flo=flo+one ENDIF lo=SIGN(flo*10.0**(ordlo-1),lo) ENDIF IF (oldhi.NE.zero) THEN loghi=LOG10(ABS(oldhi)) ordhi=INT(loghi) manthi=loghi-ordhi+one IF (manthi.LT.one) THEN manthi=manthi+one ordhi=ordhi-one ENDIF fhi=10.0**manthi IF (ABS(fhi-NINT(fhi)).GT.0.1) THEN fhi=INT(fhi) IF (.NOT.neghi) fhi=fhi+one ENDIF hi=SIGN(fhi*10.0**(ordhi-1),hi) ENDIF IF ((loglo-loghi.GE.2.0).AND.(oldlo.NE.zero)) THEN hi=zero ELSE IF ((loghi-loglo.GE.2.0).AND.(oldhi.NE.zero)) THEN lo=zero ENDIF IF (ABS(lo-hi).LT.1.E-4*lo) THEN lo=lo*.999 hi=hi*1.001 ENDIF RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE Swap (f1,f2) c c ----- Swaps the values F1 and F2. c REAL f1,f2,temp c temp=f1 f1=f2 f2=temp RETURN END c c------------------------------------------------------------------------------- c SUBROUTINE ScaleDataSet (x1,x2,y1,y2,fits,xstart,dataset) c c ----- Slide/Expand/Difference the chosen data sets. This only acts on c the raw data, NOT on the various possible fits. The fits are turned c off for the data set affected. c INTEGER maxpoints,maxpointset,maxdataset,ii,i,ChooseDataSet, * offset,cdataset,dataset,ierror,m,ds1,ds2,start1,start2, * finish1,finish2,less,more,point PARAMETER (maxpoints=20000,maxdataset=30,maxpointset=2000) REAL x(maxpoints),y(maxpoints),xdata(maxpointset), * ydata(maxpointset),xminmax(2,maxdataset),x1,x2,y1,y2, * yminmax(2,maxdataset),r1,r2,r3,r4,slide,scale,diff,value INTEGER xstart(maxdataset,2) CHARACTER dset*2,UpCase*1,ans*2 LOGICAL ok,fits(5,maxdataset),f,add c DATA f/.FALSE./ c COMMON /XYDat/x,y,xdata,ydata,xminmax,yminmax c 1 CONTINUE WRITE (*,100) 100 FORMAT ('0Choose one of the following actions:'//10X,'[S]lide ', * 'a data set'/10X,'[E]xpand/shrink a data set'/10X, * '[A]dd/subtract one data set from another'/10X, * '[Q]uit and return to main menu'//' Choice [q]: ',$) READ (*,97) ans IF (UpCase(ans).EQ.'S') GOTO 10 IF (UpCase(ans).EQ.'E') GOTO 20 IF (UpCase(ans).EQ.'A') GOTO 30 RETURN c c ----- Slide the data set up/down and/or left/right c 10 CONTINUE WRITE (*,'((A),I2)') '0Slide which dataset : 1 - ',dataset WRITE (*,98) ' 0 to quit, = current dataset: ' READ (*,97,END=1) dset IF (dset(1:1).EQ.'0') GOTO 1 cdataset=ChooseDataSet(dset,dataset,ok) IF (.NOT.ok) GOTO 10 IF ((cdataset.GT.dataset).OR.(cdataset.LT.1)) THEN WRITE (*,99) 7,7,'Error in input. Reenter data set number' GOTO 10 ENDIF offset=xstart(cdataset,1)-1 WRITE (*,*) WRITE (*,98) 'Do you wish to slide the data set horzontally '// * '[n] ? ' READ (*,97,END=1) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,10000) xminmax(1,cdataset),xminmax(2,cdataset),x1,x2 ii=1 12 CONTINUE WRITE (*,98) 'Enter the amount to slide (+ve = right, -ve'// * ' = left): ' READ (*,*,ERR=1000,IOSTAT=ierror,END=1) slide DO 13 i=1,xstart(cdataset,2) x(offset+i)=x(offset+i)+slide 13 CONTINUE xminmax(1,cdataset)=xminmax(1,cdataset)+slide xminmax(2,cdataset)=xminmax(2,cdataset)+slide DO 14 i=2,5 fits(i,cdataset)=f 14 CONTINUE ENDIF WRITE (*,*) WRITE (*,98) 'Do you wish to slide the data set vertically '// * '[n] ? ' READ (*,97,END=1) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,10001) yminmax(1,cdataset),yminmax(2,cdataset),y1,y2 ii=2 15 CONTINUE WRITE (*,98) 'Enter the amount to slide (+ve = up, -ve'// * ' = down): ' READ (*,*,ERR=1000,IOSTAT=ierror,END=1) slide DO 16 i=1,xstart(cdataset,2) y(offset+i)=y(offset+i)+slide 16 CONTINUE yminmax(1,cdataset)=yminmax(1,cdataset)+slide yminmax(2,cdataset)=yminmax(2,cdataset)+slide DO 17 i=2,5 fits(i,cdataset)=f 17 CONTINUE ENDIF GOTO 10 c c ----- Expand/contract the data set in the x/y directions c 20 CONTINUE WRITE (*,'((A),I2)') '0Scale which dataset : 1 - ',dataset WRITE (*,98) ' 0 to quit, = current dataset: ' READ (*,97,END=1) dset IF (dset(1:1).EQ.'0') GOTO 1 cdataset=ChooseDataSet(dset,dataset,ok) IF (.NOT.ok) GOTO 20 IF ((cdataset.GT.dataset).OR.(cdataset.LT.1)) THEN WRITE (*,99) 7,7,'Error in input. Reenter data set number' GOTO 20 ENDIF offset=xstart(cdataset,1)-1 WRITE (*,*) WRITE (*,98) 'Do you wish to scale the X range [n] ? ' READ (*,97,END=1) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,10000) xminmax(1,cdataset),xminmax(2,cdataset),x1,x2 WRITE (*,10002) ii=3 21 CONTINUE WRITE (*,98) 'Conversion: ' READ (*,*,ERR=1000,IOSTAT=ierror,END=1) r1,r2,r3,r4 IF ((r1.EQ.r2).OR.(r3.EQ.r4)) GOTO 1000 scale=(r4-r3)/(r2-r1) DO 22 i=1,xstart(cdataset,2) x(offset+i)=x(offset+i)*scale 22 CONTINUE xminmax(1,cdataset)=xminmax(1,cdataset)*scale xminmax(2,cdataset)=xminmax(2,cdataset)*scale DO 23 i=2,5 fits(i,cdataset)=f 23 CONTINUE ENDIF WRITE (*,*) WRITE (*,98) 'Do you wish to scale the Y range [n] ? ' READ (*,97,END=1) ans IF (UpCase(ans).EQ.'Y') THEN WRITE (*,10001) yminmax(1,cdataset),yminmax(2,cdataset),y1,y2 WRITE (*,10002) ii=4 24 CONTINUE WRITE (*,98) 'Conversion: ' READ (*,*,ERR=1000,IOSTAT=ierror,END=1) r1,r2,r3,r4 IF ((r1.EQ.r2).OR.(r3.EQ.r4)) GOTO 1000 scale=(r4-r3)/(r2-r1) DO 25 i=1,xstart(cdataset,2) y(offset+i)=y(offset+i)*scale 25 CONTINUE yminmax(1,cdataset)=yminmax(1,cdataset)*scale yminmax(2,cdataset)=yminmax(2,cdataset)*scale DO 26 i=2,5 fits(i,cdataset)=f 26 CONTINUE ENDIF GOTO 20 c c ----- Subtract/add one data set from/to another c 30 CONTINUE WRITE (*,*) WRITE (*,98) '[A]dd, [S]ubtract, or [Q]uit [q]: ' READ (*,97,END=1) ans IF (ans.EQ.'qq') RETURN ans=UpCase(ans) IF (ans.EQ.'Q') GOTO 1 add=(ans.EQ.'A') ii=5 31 CONTINUE WRITE (*,3100) dataset 3100 FORMAT (' Enter the dataset numbers (first +- second = newfirst)', * ' [ 1 - ',I,']: ',$) READ (*,*,ERR=1000,IOSTAT=ierror,END=1) ds1,ds2 IF ((ds1.GT.dataset).OR.(ds2.GT.dataset).OR.(ds1.LT.1).OR. * (ds2.LT.1).OR.(ds1.EQ.ds2)) GOTO 1000 start1=xstart(ds1,1) start2=xstart(ds2,1) finish1=start1-1+xstart(ds1,2) finish2=start2-1+xstart(ds2,2) 32 CONTINUE IF (x(start1).LT.x(start2)) THEN start1=start1+1 IF (start1.GT.finish1) GOTO 37 GOTO 32 ENDIF 33 CONTINUE IF (x(finish1).GT.x(finish2)) THEN finish1=finish1-1 IF (start1.GT.finish1) GOTO 37 GOTO 33 ENDIF c c ----- Now, data set 1 is bracketed inside data set 2. A linear c interpolation is used between two points from data set 2 to c correspond to the point in question from data set 1. c more=start2+1 DO 35 point=start1,finish1 34 CONTINUE IF (x(more).LT.x(point)) THEN more=more+1 IF (more.GT.finish2) GOTO 38 GOTO 34 ENDIF less=more-1 diff=x(more)-x(less) value=y(more) IF (diff.GT.0.0) value=value-(value-y(less))*(x(more)-x(point))/ * diff IF (add) value=-value y(point)=y(point)-value 35 CONTINUE DO 36 i=2,5 fits(i,ds1)=f 36 CONTINUE GOTO 30 37 CONTINUE WRITE (*,'(''0'',2A1,(A),I3,A2,I3,(A))') 7,7, * '*** Error. Datasets',ds1,',',ds2,' do not overlap. ***' GOTO 30 c c ----- Should never actually get here c 38 CONTINUE WRITE (*,99) 7,7,'*** Program error in adding/subtracting. ***' GOTO 30 c c ----- Error checking/error flag resetting routine c 1000 CONTINUE WRITE (*,99) 7,7,'*** Error in input - redo! ***' IF (ierror.GT.0) CALL ERRTST (ierror,m) GOTO (12,15,21,24,31),ii 97 FORMAT ((A)) 98 FORMAT (1X,(A),$) 99 FORMAT ('0',2(A1),(A)) 10000 FORMAT ('0Range of x-coordinate for this dataset is [ ',E10.3, * ' to ',E10.3,' ]'/' Current plotting range of x-coordinate', * ' is [ ',E10.3,' to ',E10.3,' ]'/) 10001 FORMAT ('0Range of y-coordinate for this dataset is [ ',E10.3, * ' to ',E10.3,' ]'/' Current plotting range of y-coordinate', * ' is [ ',E10.3,' to ',E10.3,' ]'/) 10002 FORMAT ('0Enter the value to be scaled by specifying a range ', * 'conversion:'//3X,'ex. 0 1 0 35.7'/8X,'converts the ', * 'old range from 0 to 1 to a new range from 0 to 35.7'/) END c c------------------------------------------------------------------------------- c c SUBROUTINE Description cc cc ----- A short description of the programme CurveFit cc c CHARACTER ans*1 cc c WRITE (*,100) c100 FORMAT ('0',32X,'CurveFit'//7X,'A general curve fitting routin', c * 'e with graphics for systems with PGPlot.'//5X, c * 'CurveFit will plot up to 30 data sets of up to 2000 points', c * ' each,'/1X,'(to a maximum of 20000 points), saved as (xp,', c * 'yp) in ascending {xp}'/1X,'order. It can also modify the ', c * 'data set, by flipping the x and/or y'/1X, c * 'axes, taking logarithms of any x and/or y data, and/or ', c * 'scaling any'/1X,'data set in the x and/or y directions.'//5X, c * 'In addition, CurveFit allows one to fit ', c * 'various types of curves to'/1X,'the data sets. These ', c * 'include:'/7X,'(a) straight line (connect the dots)'/7X, c * '(b) cubic spline'/7X,'(c) smoothing (Bezier) polynomial', c * /7X,'(d) low-pass Fourier transform filter'/7X,'(e) a ', c * 'best-fit polynomial of up to 10 terms'//5X,'CurveFit is ', c * 'menu driven and allows one to display any intermediary'/1X, c * 'results. The x,y plotting ranges are user determined, as', c * ' is the fitting'/1X,'range (over the x coordinate). Plots', c * ' can be made on any device that is'/1X,'supported by PG', c * 'Plot.'////1X,'Press to continue',$) c READ (*,'((A))') ans c WRITE (*,'(''1'')') c RETURN c END hi).LT.1.E-4pgplot/applications/plotpg/about_fi_plt.in010064400040640000322000000013670536111507600215370ustar00tjpcitmbr00000400000017From: ST%"ejst@cuphyd.bitnet" 16-MAY-1990 12:12:44.66 To: TJP CC: Subj: about fi_plt.in Received: from CUPHYD by Deimos.Caltech.Edu via BITNET ; Wed, 16 May 90 12:12:37 PDT Received: From CUPHYD(EJST) by CITDEIMO with Jnet id 3599 for TJP@CITDEIMO; Wed, 16 May 90 12:12 PST Message-Id: <900516121237.27e000a2@Deimos.Caltech.Edu> Date: Wed, 16 May 90 15:21 EST From: Subject: about fi_plt.in To: tjp@citdeimo Original_To: JNET%"tjp@citdeimo.bitnet" If fi_plt.in is typed on the same line as the command to execute plotpg, then everything will be done automatically. This includes picking the device, deciding how many plots on the page, and chosing fi.plt as the command file, putting labels in the right places. pgplot/applications/plotpg/fi.plt010064400040640000322000000003530536111507700176520ustar00tjpcitmbr00000400000017datafile sample.dat 6 xycolumn 1 6 tlabel 3-COMPONENT MODEL xlabel F\dI\u ylabel \(648)\u2\d setc 1.5 setlw 3 env 0 1 5 20 line plot 6 line plot 6 line plot 6 line plot 7 label labels setls 2 repeat 4 line plot 6 endrepeat labels quit pgplot/applications/plotpg/fi_plt.in010064400040640000322000000001500536111507700203330ustar00tjpcitmbr00000400000017fi.plt /x11 1 1 Rc = 5 .18 18 10 .38 18 15 .48 18 20 .69 18 5 .59 18 10 .87 18 15 .90 15 20 .9 12 y pgplot/applications/plotpg/plotpg.hlp010064400040640000322000000170450536111510000205360ustar00tjpcitmbr00000400000017From: ST%"ejst@cuphyd.bitnet" 16-MAY-1990 12:11:03.45 To: TJP CC: Subj: plotpg.hlp Received: from CUPHYD by Deimos.Caltech.Edu via BITNET ; Wed, 16 May 90 12:10:51 PDT Received: From CUPHYD(EJST) by CITDEIMO with Jnet id 7066 for TJP@CITDEIMO; Wed, 16 May 90 12:10 PST Message-Id: <900516121051.27e000a2@Deimos.Caltech.Edu> Date: Wed, 16 May 90 15:14 EST From: Subject: plotpg.hlp To: tjp@citdeimo Original_To: JNET%"tjp@citdeimo.bitnet" Interactive Pgplot via [Version 2.1] August 1989 Program PLOTPG from Ed Shaya PLOTPG USER'S GUIDE This is a quick description of how to operate PLOTPG, a facility which allows either interactive or command file operation of PGPLOT. With this facility, you need not write a program to make simple plots with PGPLOT. The data you want plotted just need to be in a file with any number of columns. Within PLOTPG, you specify the file with the command DATAFILE followed by the name of the file and the number of columns in the file. The program will read your data file in free format (not very good with strings). You specify which columns in the data file are to be used for x and y in the upcoming plot via the command XYCOLUMN. To start the program, type: $ plotpg PLOTPG will prompt you for the 'Plotting Command File:'; the response 'terminal' will allow the session to be interactive, otherwise you can respond with the filename of a command list. The commands read in are recorded in the file 'plt.plt'. Once produced 'plt.plt' can be copied, edited, and then used as the command file for similar plots. Next the program requests the 'Graphics device/type: '. The usual response, such as /tek (Tektronics graphics) or /ps (Postscript for Laserwriters) will direct the output for this pgplot run. Then you are asked how the page will be divided into sections. The page can be divided into NX horizontal sections and NY verticle sections. For one plot per page, the response should be "1 1". The command ENV will set up the axes. The data is plotted only when the command PLOT is given. No more than 500 points can be plotted at a time, but the command PLOT can be repeated. The '%' sign is the comment character; any line beginning with '%' is ignored. Limited online help is available by typing: 'help any_command'. A UNIX system command can be executed by starting the command line with the '$' symbol. The following are the commands that PLOTPG understands. Each command is followed by specified parameters. The parameters may be real, integer or strings. No quotes are necessary for strings. Be sure to give all required parameters for each command. Refer to the PGPLOT manual for more information about the basic operations. If you wish more PGPLOT commands to be incorporated, let me know and I can simply add them. ED SHAYA 8/15/89 COMMANDS: ========= For labeling and setting up coordinates: xlabel ANYSTRING label for x-axis ylabel ANYSTRING Label for y-axis. tlabel ANYSTRING Label for top of plot. setc CHARACTER_SIZE Character size [1.0]. setlw LINE_WIDTH Line thickness. setls LINE_STYLE 1-FULL,2-DASHED,3-DOTDASH,4-DOTTED, OR 5-FANCY setfont FONT_TYPE 1-NORMAL, 2-ROMAN, 3-ITALIC, 4-SCRIPT just Set just-parameter for pgenv to 1. axis INTEGER Set axis-parameter for pgenv. env XMIN XMAX YMIN YMAX Set up axes with numerical labels. autoscale Switch on and off autoscale of axes: with autoscale, axes are automatically set up during plotting. label Put x,y and tlabels around axes. advance Advance to a new (sub)page. vstand Define viewport to be standard viewport. window X1 X2 Y1 Y2 Change the window in world coordinate space. box XOPT XTICK NXSUB YOPT YTICK NYSUB Calls pgbox with standard options. vport XLEFT XRIGHT YBOT YTOP Change viewport, specified in normalized device coordinates. The file with the data is specified so: datafile NAME_OF_FILE NUMBER_OF_COL xycolumn NX NY string Use if first column contains string names. nostring To turn off string flag. Various ways of plotting the data: point POINT_SYMBOL plot data as points. All data with same symbol. points NCOL_POINT_SYMBOL Plot data as points. Symbol types in column NCOL_POINT_SYMBOL of datafile. line connect data with a line hist DATAMIN DATAMAX histogram that bins for you bin CENTER (Logical) histogram that you bin move X Y move without plotting draw X Y a simple straight line to X,Y To add error bars: errx NERRX1 NERRX2 ERRXT erry NERRY1 NERRY2 ERRYT To actually plot: plot NDATA_PTS The datafile is read and the data is plotted. If you don't know how many data points there are just use 500 which is the largest number permitted. Add legends and strings anywhere in the graph interactively: labels You are then prompted for the text and the coordinates of the labels. rewind To rewind the datafile. skip NSKIP To skip NSKIP lines. print To print out x, y data values before plotting. noprint To turn off printing of x,y data values. Some odd-and-ends help COMMAND Get online help for each command. text NCOLUMN To plot the values in a third column at the given x,y position. curse [X Y] Obtain interactively the X,Y position on the plot. X and Y are optional coordinates. Move the cursors with the arrows, then hit any key to get coordinates. repeat NUMBER_OF_TIMES Repeats following commands multiple times. endrepeat Ends section of commands to be repeated goto LABEL Continue commands after LABEL:. Be sure to add ':'. Rotation of coordinate axes: rottheta ANGLE(radians) Rotates viewer and axes counterclockwise around z-axis. rotphi ANGLE(radians) Rotates viewer and axes counterclockwise around x-axis. If both rotations are made rottheta is done first. xyzcolumn X_COLUMN Y_COLUMN Z_COLUMN Needed for rotphi command only. polar NTHETA_COLUMN NR_COLUMN Use polar coordinates: instead of xycolumn. Use spherical coordinates: spherical NTHETA_COLUMN NPHI_COLUMN NR_COLUMN instead of xycolumn. lwswitch Turn off and on the setlw command. (when off, setlw = 1) Connect a second point along the same radial direction with each point (in spherical coordinates): pair SECOND_ND terminal Return to interactive mode from a command file. commandfile [filename] Return control to previous command file or name a new one. quit When finished. pgplot/applications/plotpg/plotpg.unix010064400040640000322000000566410536111510100207440ustar00tjpcitmbr00000400000017 program plotpg c Purpose - General purpose plotting routine integer pgbegin,ilw(10),n(500) character*80 device,xlbl,ylbl,toplbl,fildat,label character*80 sline,filnm,scommnd,replist(100) character*25 spar(10),scom,dum,querry,spar1,spar2,spar3 character*1 snx,sny character txt(500)*4,ch*1,name*10,golabel*15,comfile*20 logical*1 text,errx,erry,line,point,polar,pair,bin,center logical*1 hist,rewind,lwswitch,spherical,rotphi,rottheta logical*1 autoscale,filesw,prnt,nmstrg,interact,points logical*1 dash_inbound,record,repeat,eofsw real a(15),x(500),y(500),x1(500),x2(500),y1(500),y2(500) real p(2),q(2),z(500),z2(500) integer ipts(500) call getarg(1,comfile) if (comfile .ne. ' ') open(unit=5,file=comfile,readonly) inchni = 11 inchn = inchni print*, '===========================================================' print*, ' Version 2.2' print*, 'This is PLOTPG, a facility which allows either interactive or' print*, 'command file operation of PGPLOT. With this facility, you' print*, 'need not write a program to make plots with PGPLOT. The' print*, 'data you want plotted just need to be in a file with any' print*, 'number of columns. You specify the file with the command ' print*, 'DATAFILE followed by the name of the file and the number' print*, 'of columns in the file. The program will read your data' print*, 'file in free format (not very good with strings). You' print*, 'specify which columns in the data file are to be used for' print*, 'x and y data values via the command XYCOLUMN.' print*, 'PLOTPG will prompt you for the "Plotting Command File:";' print*, 'the response "terminal" or CR will allow the session to be' print*, 'interactive, otherwise you can respond with the filename ' print*, 'of a command list. The commands are recorded in ' print*, 'the file "plt.plt". Once produced, "plt.plt" can be copied,' print*, 'edited, and then used as the command file for similar plots.' print*, ' A program by Ed Shaya ' print*, '===========================================================' ls = 1 8 print*, ' Plotting Command File [For interactive - ''terminal'']:' read(*,'(a)') filnm if (filnm .eq. 'help') goto 140 print*, filnm if (filnm(1:8) .eq. 'terminal' .or. filnm .eq. ' ') then interact = 1 inchn = 5 else open(inchn,file = filnm,status='old',readonly,err=8) end if filesw = 0 indata = 12 iout = 10 open(iout, file = 'plt.plt', status = 'unknown') 20 print *, 'Graphics device/type: [/tek] ' read(*,'(a)') device if (device .eq. ' ') device = '/tek' print *,'Number of sections in X direction: (usual 1)' read(*,'(a)') snx if (snx .eq. ' ') then nx = 1 ny = 1 goto 40 end if read(snx,'(i1)') nx if (nx .eq. 0) nx = 1 print *,'Number of sections in Y direction: (usual 1)' read(*,'(a)') sny read(sny,'(i1)') ny if (ny .eq. 0) ny = 1 40 if (.not.(pgbegin(12,device,nx,ny) .eq. 1)) goto 20 c ##==== set line width arrays ===# do kk = 1,10 ilw(kk) = kk end do autoscale = 0 lwswitch = 1 just = 0 axis = 0 if (interact) write(*,*) ' Begin commands.' 100 if (repeat) then jline = jline + 1 sline = replist(jline) if (jline .eq. jlinet) then jline = 0 repcnt = repcnt + 1 if (repcnt .eq. nreps-1) then repeat = 0 end if end if else read(inchn,110) sline write(iout,111) sline 110 format(a80) 111 format (a69) end if if (sline(1:1) .eq. '%') goto 100 if (record) then jline = jline + 1 replist(jline) = sline end if call split_line(sline,spar) scom = spar(1) if (scom .eq. ' ') go to 100 if (scom .eq. '$') then ln = index(sline,'$') scommnd = sline(ln+1:30+ln) write(*,*) ln,scommnd kcom = system(scommnd) else if (scom .eq. 'help') then if (spar(2) .eq. ' ') then scommnd = 'more /mnt1/ejs/utils/plotpg.hlp' else 140 scommnd = 'grep ^'//spar(2)//'/mnt1/ejs/utils/plotpg.hlp' end if kcom = system(scommnd) else if (scom .eq. 'repeat') then read(spar(2),*,end=900) nreps spar1 = 'NUMBER_OF_REPEATS' jline = 0 repcnt = 0 record = 1 else if (scom .eq. 'endrepeat') then jlinet = jline - 1 jline = 0 record = 0 repeat = 1 else if (scom .eq. 'goto') then golabel = spar(2) let = index(golabel,' ') golabel(let:let) = ':' eofsw = 0 175 do while (golabel .ne. spar(1)) read(inchn,110,end=180) sline call split_line(sline,spar) end do go to 100 180 if (eofsw) then write(*,*) 'Missing Label ',golabel stop else eofsw = 1 end if rewind inchn go to 175 else if (scom .eq. 'terminal') then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' else if (scom .eq. 'commandfile') then inchn = inchni interact = 0 if (spar(2) .ne. ' ') then close(inchn) open(unit=inchn,file=spar(2),status='old',readonly) end if else if (scom .eq. 'xlabel') then xlbl = spar(2) ln1 = 0 do jj = 3, 10 ln = index(xlbl(ln1+1:),' ') xlbl = xlbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'ylabel') then ln1 = 0 ylbl = spar(2) do jj = 3, 10 ln = index(ylbl(ln1+1:),' ') ylbl = ylbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'tlabel') then ln1 = 0 toplbl = spar(2) do jj = 3, 10 ln = index(toplbl(ln1+1:),' ') toplbl = toplbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'setc') then spar1 = 'SETC' read(spar(2),*,end=900) csize call pgsetc(csize) else if (scom .eq. 'setlw') then spar1 = 'LSIZE' read(spar(2),*,end=900) lsize call grsetlw(ilw(lsize)) else if (scom .eq. 'setfont') then spar1 = 'IFONT' read(spar(2),*,end=900) ifont call grsetfont(ifont) else if (scom .eq. 'lwswitch') then if (lwswitch .eq. 1) then lwswitch = 0 do kk = 1,10 ilw(kk) = 1 end do else lwswitch = 1 do kk = 1,10 ilw(kk) = kk end do end if else if (scom .eq. 'datafile') then fildat = spar(2) spar1 = 'FILENAME' spar2 = 'NCOL' read(spar(3),*,end=950) ncol close(indata) indata = indata + 1 open(unit=indata,file=fildat,status = 'old',readonly, x err = 80) filesw = 1 goto 90 80 write(*,'(a25,a25)') 'Unable to find datafile ',fildat filesw = 0 goto 100 90 continue else if (scom .eq. 'pair') then pair = 1 spar1 = 'ND2' read(spar(2),*,end=900) nx2 read(spar(3),*,end=220) ny2 else if (scom .eq. 'dash_inbound') then dash_inbound = 1 220 else if (scom .eq. 'spherical') then spherical = 1 spar1 = 'NTHETA' spar2 = 'NPHI' spar3 = 'ND' read(spar(2),*,end=970) ntheta read(spar(3),*,end=970) nphi read(spar(4),*,end=970) nd else if (scom .eq. 'rottheta') then rottheta = 1 spar1 = 'THETA' read(spar(2),*,end=900) theta else if (scom .eq. 'rotphi') then rotphi = 1 spar1 = 'PHI' read(spar(2),*,end=900) phi else if (scom .eq. 'polar') then polar = 1 spar1 = 'NTHETA' spar2 = 'ND' read(spar(2),*,end=950) ntheta read(spar(3),*,end=950) nd else if (scom .eq. 'xycolumn') then spar1 = 'NX' spar2 = 'NY' read(spar(2),*,end=950) nx read(spar(3),*,end=950) ny else if (scom .eq. 'xyzcolumn') then spar1 = 'NX' spar2 = 'NY' spar3 = 'NZ' read(spar(2),*,end=970) nx read(spar(3),*,end=970) ny read(spar(4),*,end=970) nz else if (scom .eq. 'point') then point = 1 spar1 = 'IPT' read(spar(2),*,end=900) ipt else if (scom .eq. 'points') then points = 1 spar1 = 'NCOL_POINT_SYMBOL' read(spar(2),*,end=900) nipts else if (scom .eq. 'line') then line = 1 else if (scom .eq. 'errx') then errx = 1 spar1 = 'N_COL_ERRX1' spar2 = 'N_COL_ERRX2' spar3 = 'ERRXTYPE' read(spar(2),*,end=970) nerrx1 read(spar(3),*,end=970) nerrx2 read(spar(4),*,end=970) errxt else if (scom .eq. 'erry') then erry = 1 spar1 = 'N_COL_ERRY1' spar2 = 'N_COL_ERRY2' spar3 = 'ERRYTYPE' read(spar(2),*,end=970) nerry1 read(spar(3),*,end=970) nerry2 read(spar(4),*,end=970) erryt else if (scom .eq. 'text') then text = 1 spar1 = 'N_COL' read(spar(2),*,end=900) namcol else if (scom .eq. 'hist') then spar1 = 'DAT_MIN' spar2 = 'DAT_MAX' hist = 1 read(spar(2),*,end=950) datmin read(spar(3),*,end=950) datmax else if (scom .eq. 'curse') then call pgupdt(1) if (spar(2) .ne. ' ') then read(spar(2),*,end=900) xcoord read(spar(3),*,end=900) ycoord end if call pgcurse(xcoord,ycoord,ch) write(*,*) ch,xcoord,ycoord else if (scom .eq. 'labels') then call pgupdt(1) nlabel = 1 write(*,*) ' Present character size is ',csize write(*,*) ' Begin placing labels [ to end]' 500 print *,' Label ', nlabel read(*,'(a)') label if (label .eq. '') then if (interact) write(*,*) ' Continue commands' goto 100 end if print *,' X,Y position of label' read(*,*) xcoord,ycoord call pgtext(xcoord,ycoord,label) nlabel = nlabel + 1 goto 500 else if (scom .eq. 'setls') then spar1 = 'LINE_STYLE' read(spar(2),*,end=900) ls call grsetls(ls) else if (scom .eq. 'draw') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgdraw(xcoord,ycoord) else if (scom .eq. 'move') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgmove(xcoord,ycoord) else if (scom .eq. 'bin') then spar1 = 'CENTER [LOGICAL]' read(spar(2),*,end=900) center bin = 1 else if (scom .eq. 'just') then just = 1 else if (scom .eq. 'axis') then spar1 = 'NAXIS' read(spar(2),*,end=900) naxis else if (scom .eq. 'env') then if (autoscale) then write(*,*) ' Autoscale is on.' write(*,*) ' Axes drawn during plot execution.' else spar1 = 'XMIN XMAX' spar2 = 'YMIN YMAX' read(spar(2),*,end=950) xmin read(spar(3),*,end=950) xmax read(spar(4),*,end=950) ymin read(spar(5),*,end=950) ymax xcoord = (xmax-xmin)/2. ycoord = (ymax-ymin)/2. call pgenv(xmin,xmax,ymin,ymax,just,naxis) just = 0 end if else if (scom .eq. 'autoscale') then if (autoscale) then autoscale = 0 else autoscale = 1 end if else if (scom .eq. 'label') then call pglabel(xlbl,ylbl,toplbl) else if (scom .eq. 'skip') then if (.not. filesw) goto 800 spar1 = 'NLINES' read(spar(2),*,end=900) nlines do jj = 1, nlines read(indata,'(a)') dum end do write(*,'(i5,a,a20)') nlines,' lines skipped in ',fildat else if (scom .eq. 'rewind') then rewind = 1 if (rewind) rewind(indata) else if (scom .eq. 'print') then prnt = 1 else if (scom .eq. 'noprint') then prnt = 0 else if (scom .eq. 'strings') then nmstrg = 1 else if (scom .eq. 'nostrings') then nmstrg = 0 else if (scom .eq. 'vport') then spar1 = 'XLEFT XRIGHT' spar2 = 'YBOT YTOP' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgvport(xleft,xright,ybot,ytop) else if (scom .eq. 'advance') then call pgadvance else if (scom .eq. 'vstand') then call pgvstand else if (scom .eq. 'window') then spar1 = 'X1 X2' spar2 = 'Y1 Y2' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgwindow(xleft,xright,ybot,ytop) else if (scom .eq. 'box') then spar1 = 'XOPT XTICK' spar2 = 'NXSUB YOPT' spar3 = 'YTICK NYSUB' read(spar(2),*,end=980) xopt read(spar(3),*,end=980) xtick read(spar(4),*,end=980) nxsub read(spar(5),*,end=980) yopt read(spar(5),*,end=980) ytick read(spar(5),*,end=980) nysub call pgbox(xopt,xtick,nxsub,yopt,ytick,nysub) else if (scom .eq. 'plot') then spar1 = 'NDATA_PTS' read(spar(2),*,end=900) ntot if (ntot .gt. 500) then ntot = 500 write(*,*) ' Only 500 points can be plotted at a time' end if if (.not. filesw) goto 800 call pgupdt(0) C #== READ IN DATA AND SET X, Y AND ERROR ARRAYS ===# j = 0 do i = 1, ntot if (nmstrg) then read(indata,*,end=850) name,(a(j),j=2,ncol) else read(indata,*,end=850) (a(j),j=1,ncol) end if if (spherical) then x(i) = a(nd)*cos(a(ntheta))*sin(a(nphi)) y(i) = a(nd)*sin(a(ntheta))*sin(a(nphi)) z(i) = a(nd)*cos(a(nphi)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) z2(i) = a(nx2)*z(i)/a(nd) end if else if (polar) then x(i) = a(nd)*cos(a(ntheta)) y(i) = a(nd)*sin(a(ntheta)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) end if else if (hist) then x(i) = a(nx) else x(i) = a(nx) y(i) = a(ny) if (pair) then x2(i) = a(nx2) y2(i) = a(ny2) end if if (rotphi) z(i) = a(nz) end if if (points) then ipts(i) = a(nipts) end if if (errx) then x1(i) = x(i) - a(nerrx1) x2(i) = x(i) + a(nerrx2) end if if (erry) then y1(i) = y(i) - a(nerry1) y2(i) = y(i) + a(nerry2) end if if (text) then if (nmstrg .and. namcol .eq. 1) then txt(i) = name else n(i) = a(namcol) if (n(i) .le. 9) then write(txt(i),'(i1)') n(i) else if (n(i) .le. 99) then write(txt(i),'(i2)') n(i) else if (n(i) .le. 999) then write(txt(i),'(i3)') n(i) end if end if end if if (prnt) print *,i,name,x(i),y(i) if (rottheta) then x(i) = x(i)*cos(theta)+y(i)*sin(theta) y(i) = -x(i)*sin(theta)+y(i)*cos(theta) if (pair) then x2(i) = x2(i)*cos(theta)+y2(i)*sin(theta) y2(i) = -x2(i)*sin(theta)+y2(i)*cos(theta) end if end if if (rotphi) then y(i) = y(i)*cos(phi)+z(i)*sin(phi) if (pair) y2(i) = y2(i)*cos(phi)+z2(i)*sin(phi) end if end do 850 itot = i - 1 write(*,'(i4,a17,a20)') itot,' lines read from ',fildat if (text) then do k = 1,itot call pgtext(x(k),y(k),txt(k)) end do end if if (autoscale) then xmina = x(1) ymina = y(1) xmaxa = x(1) ymaxa = y(1) do ijk = 2, itot if (x(ijk) .gt. xmaxa) xmaxa = x(ijk) if (y(ijk) .gt. ymaxa) ymaxa = y(ijk) if (x(ijk) .lt. xmina) xmina = x(ijk) if (y(ijk) .lt. ymina) ymina = y(ijk) end do plusx = (xmaxa-xmina)*.05 plusy = (ymaxa-ymina)*.05 xmina = xmina - plusx xmaxa = xmaxa + plusx ymina = ymina - plusy ymaxa = ymaxa + plusy call pgenv(xmina,xmaxa,ymina,ymaxa,just,axis) end if if (point) call pgpoint(itot,x,y,ipt) if (points) call pgpoint(itot,x,y,ipts) if (line) call pgline(itot,x,y) if (bin) call pgbin(itot,x,y,center) if (hist) call pghist(itot,x,datmin,datmax,itot,1) if (pair) then do i = 1, itot p(1) = x(i) q(1) = y(i) p(2) = x2(i) q(2) = y2(i) if (dash_inbound) then if (p(1)**2+q(1)**2 .gt. p(2)**2+q(2)**2) then call grsetls(4) else call grsetls(1) end if end if call pgline(2,p,q) end do call grsetls(ls) end if if (errx) then call pgerrx(itot,x1,x2,y,errxt) end if if (erry) then call pgerry(itot,x,y1,y2,erryt) end if pair = 0 spherical = 0 rotphi = 0 rottheta = 0 polar = 0 line = 0 point = 0 points = 0 errx = 0 erry = 0 text = 0 labels = 0 hist = 0 rewind = 0 else if (scom .eq. 'quit') then goto 999 else write(*,*) ' Do not understand ',scom write(iout,*) ' Do not understand ',scom end if go to 100 800 write(*,*) 'No datafile chosen. Use command DATAFILE.' goto 980 900 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17)') scom,spar1 go to 980 950 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17,2x,a17)') scom,spar1,spar2 go to 980 970 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17,2x,a17,2x,a17)') scom,spar1,spar2,spar3 go to 980 980 if (.not.interact) then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' write(*,985) ' Type "commandfile" to return control to ',filnm 985 format(a,a17) end if go to 100 999 call pgupdt(1) call pgend close(indata) if (device .eq. '/ps') then write(*,'(a)') ' Send plot to laserwriter?' read(*,'(a)') querry if (querry(1:1) .eq. 'y') then kcom = system('print -v PGPLOT.PS') write(*,*) ' Printing' end if end if end env') then if (autoscale) then write(*,*) ' Autoscale ipgplot/applications/plotpg/plotpg.vms010064400040640000322000000623150536111510200205620ustar00tjpcitmbr00000400000017 program plotpg c Purpose - General purpose plotting routine integer pgbegin,ilw(10),n(500) character*80 device,xlbl,ylbl,toplbl,fildat,label character*80 sline,filnm,scommnd,replist(100) character*25 spar(10),scom,dum,querry,spar1,spar2,spar3 character*1 snx,sny logical*1 text,errx,erry,line,point,polar,pair,bin,center logical*1 hist,rewind,lwswitch,spherical,rotphi,rottheta logical*1 autoscale,filesw,prnt,nmstrg,interact,points logical*1 dash_inbound,record,repeat,eofsw character txt(500)*4,ch*1,name*10,golabel*15 real a(15),x(500),y(500),x1(500),x2(500),y1(500),y2(500) real p(2),q(2),z(500),z2(500) integer ipts(500) inchni = 11 inchn = inchni print*, '======================================================' print*, ' Version 2.3' print*, 'This is PLOTPG, a facility which allows either' print*, 'interactive or command file operation of PGPLOT.' print*, 'With this facility, you need not write a program to' print*, 'make plots with PGPLOT. The data you want plotted' print*, 'just need to be in a file with any number of columns.' print*, 'You specify the file with the command DATAFILE' print*, 'followed by the name of the file and the number of' print*, 'columns in the file. The program will read your data' print*, 'file in free format (not very good with strings).' print*, 'You specify which columns in the data file are to be' print*, 'used for x and y in the upcoming plot via the command' print*, 'XYCOLUMN. PLOTPG will prompt you for the "Plotting' print*, 'Command File:"; the response "terminal" will allow the' print*, 'session to be interactive, otherwise you can respond' print*, 'with the filename of a command list. The commands' print*, 'read in are recorded in the file "plt.out". Once' print*, 'produced, "plt.out" can be copied, edited, and' print*, 'used as the command file for similar plots.' print*, ' A program by Ed Shaya' print*, '======================================================' ls = 1 8 print*, ' Command File [For interactive - ''terminal'']:' read(*,'(a)') filnm if (filnm .eq. 'help') goto 140 print*, filnm if (filnm(1:8) .eq. 'terminal' .or. filnm .eq. ' ') then interact = 1 inchn = 5 else open(inchn,file = filnm,status='old',readonly,err=8) end if filesw = 0 indata = 12 iout = 10 open(iout, file = 'plt.out', status = 'unknown') 20 print *, 'Graphics device/type: [/tek] ' read(*,'(a)') device if (device .eq. ' ') device = '/tek' print *,'Number of sections in X direction: (usual 1)' read(*,'(a)') snx if (snx .eq. ' ') then nx = 1 ny = 1 goto 40 end if read(snx,'(i1)') nx if (nx .eq. 0) nx = 1 print *,'Number of sections in Y direction: (usual 1)' read(*,'(a)') sny read(sny,'(i1)') ny if (ny .eq. 0) ny = 1 40 if (.not.(pgbegin(12,device,nx,ny) .eq. 1)) goto 20 c ##==== set line width arrays ===# do kk = 1,10 ilw(kk) = kk end do autoscale = 0 lwswitch = 1 just = 0 axis = 0 if (interact) write(*,*) ' Begin commands.' 100 if (repeat) then jline = jline + 1 sline = replist(jline) if (jline .eq. jlinet) then jline = 0 repcnt = repcnt + 1 if (repcnt .eq. nreps-1) then repeat = 0 end if end if else read(inchn,110) sline write(iout,111) sline 110 format(a80) 111 format (a69) end if if (sline(1:1) .eq. '%') goto 100 if (record) then jline = jline + 1 replist(jline) = sline end if call split_line(sline,spar) scom = spar(1) if (scom .eq. ' ') go to 100 if (scom .eq. '$') then ln = index(sline,'$') scommnd = sline(ln+1:30+ln) istat=lib$spawn(scommnd,,,,,,,,,,,) if (.not. istat) call lib$stop(%val(istat)) write(*,'(/,a,/)') ' Continue PLOTPG commands.' c =============================== c Unix c kcom = system(scommnd) c else if (scom .eq. 'help') then c if (spar(2) .eq. ' ') then c scommnd = 'more /mnt1/ejs/utils/plotpg.hlp' c else c 140 scommnd = 'grep ^'//spar(2)//'/mnt1/ejs/utils/plotpg.hlp' c end if c ============================== c VMS else if (scom .eq. 'help') then if (spar(2) .ne. ' ') then scommnd = 'search [soft.notes]plotpg.hlp '//spar(2) istat=lib$spawn(scommnd,,,,,,,,,,,) if (.not. istat) call lib$stop(%val(istat)) else 140 scommnd = 'page [soft.notes]plotpg.hlp' istat=lib$spawn(scommnd,,,,,,,,,,,) if (.not. istat) call lib$stop(%val(istat)) end if c =========================== write(*,'(/,a,/)') ' Continue PLOTPG commands.' c kcom = system(scommnd) else if (scom .eq. 'repeat') then read(spar(2),*,end=900) nreps spar1 = 'NUMBER_OF_REPEATS' jline = 0 repcnt = 0 record = 1 else if (scom .eq. 'endrepeat') then jlinet = jline - 1 jline = 0 record = 0 repeat = 1 else if (scom .eq. 'goto') then golabel = spar(2) let = index(golabel,' ') golabel(let:let) = ':' eofsw = 0 175 do while(golabel .ne. spar(1)) read(inchn,110,end=180) sline call split_line(sline,spar) end do go to 100 180 if (eofsw) then write(*,*) ' Missing Label ',golabel stop else eofsw = 1 end if else if (scom .eq. 'terminal') then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' else if (scom .eq. 'commandfile') then inchn = inchni interact = 0 if (spar(2) .ne. ' ') then close(inchn) open(unit=inchn,file=spar(2),status='old',readonly) end if else if (scom .eq. 'xlabel') then xlbl = spar(2) ln1 = 0 do jj = 3, 10 ln = index(xlbl(ln1+1:),' ') xlbl = xlbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'ylabel') then ln1 = 0 ylbl = spar(2) do jj = 3, 10 ln = index(ylbl(ln1+1:),' ') ylbl = ylbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'tlabel') then ln1 = 0 toplbl = spar(2) do jj = 3, 10 ln = index(toplbl(ln1+1:),' ') toplbl = toplbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'setc') then spar1 = 'SETC' read(spar(2),*,end=900) csize call pgsetc(csize) else if (scom .eq. 'setlw') then spar1 = 'LSIZE' read(spar(2),*,end=900) lsize call pgslw(ilw(lsize)) else if (scom .eq. 'setfont') then spar1 = 'IFONT' read(spar(2),*,end=900) ifont call pgscf(ifont) else if (scom .eq. 'lwswitch') then if (lwswitch .eq. 1) then lwswitch = 0 do kk = 1,10 ilw(kk) = 1 end do else lwswitch = 1 do kk = 1,10 ilw(kk) = kk end do end if else if (scom .eq. 'datafile') then fildat = spar(2) spar1 = 'FILENAME' spar2 = 'NCOL' read(spar(3),*,end=950) ncol close(indata) indata = indata + 1 open(indata,file=fildat,status = 'old',readonly, x err = 80) filesw = 1 goto 90 80 write(*,'(a25,a25)') 'Unable to find datafile ',fildat filesw = 0 goto 100 90 continue else if (scom .eq. 'pair') then pair = 1 spar1 = 'ND2' read(spar(2),*,end=900) nx2 read(spar(3),*,end=220) ny2 220 continue else if (scom .eq. 'dash_inbound') then dash_inbound = 1 else if (scom .eq. 'spherical') then spherical = 1 spar1 = 'NTHETA' spar2 = 'NPHI' spar3 = 'ND' read(spar(2),*,end=970) ntheta read(spar(3),*,end=970) nphi read(spar(4),*,end=970) nd else if (scom .eq. 'rottheta') then rottheta = 1 spar1 = 'THETA' read(spar(2),*,end=900) theta else if (scom .eq. 'rotphi') then rotphi = 1 spar1 = 'PHI' read(spar(2),*,end=900) phi else if (scom .eq. 'polar') then polar = 1 spar1 = 'NTHETA' spar2 = 'ND' read(spar(2),*,end=950) ntheta read(spar(3),*,end=950) nd else if (scom .eq. 'xycolumn') then spar1 = 'NX' spar2 = 'NY' read(spar(2),*,end=950) nx read(spar(3),*,end=950) ny else if (scom .eq. 'xyzcolumn') then spar1 = 'NX' spar2 = 'NY' spar3 = 'NZ' read(spar(2),*,end=970) nx read(spar(3),*,end=970) ny read(spar(4),*,end=970) nz else if (scom .eq. 'point') then point = 1 spar1 = 'IPT' read(spar(2),*,end=900) ipt else if (scom .eq. 'points') then points = 1 spar1 = 'NCOL_POINT_SYMBOL' read(spar(2),*,end=900) nipts else if (scom .eq. 'line') then line = 1 else if (scom .eq. 'errx') then errx = 1 spar1 = 'N_COL_ERRX1' spar2 = 'N_COL_ERRX2' spar3 = 'ERRXTYPE' read(spar(2),*,end=970) nerrx1 read(spar(3),*,end=970) nerrx2 read(spar(4),*,end=970) errxt else if (scom .eq. 'erry') then erry = 1 spar1 = 'N_COL_ERRY1' spar2 = 'N_COL_ERRY2' spar3 = 'ERRYTYPE' read(spar(2),*,end=970) nerry1 read(spar(3),*,end=970) nerry2 read(spar(4),*,end=970) erryt else if (scom .eq. 'text') then text = 1 spar1 = 'N_COL' read(spar(2),*,end=900) namcol else if (scom .eq. 'hist') then spar1 = 'DAT_MIN' spar2 = 'DAT_MAX' hist = 1 read(spar(2),*,end=950) datmin read(spar(3),*,end=950) datmax else if (scom .eq. 'curse') then call pgupdt(1) if (spar(2) .ne. ' ') then read(spar(2),*,end=900) xcoord read(spar(3),*,end=900) ycoord end if call pgcurse(xcoord,ycoord,ch) write(*,*) ch,xcoord,ycoord else if (scom .eq. 'labels') then call pgupdt(1) nlabel = 1 write(*,*) ' Present character size is ',csize write(*,*) ' Begin placing labels [ to end]' 500 print *,' Label ', nlabel read(*,'(a)') label if (label .eq. ' ') then if (interact) write(*,*) ' Continue commands' goto 100 end if print *,' X,Y position of label' read(*,*) xcoord,ycoord call pgtext(xcoord,ycoord,label) nlabel = nlabel + 1 goto 500 else if (scom .eq. 'setls') then spar1 = 'LINE_STYLE' read(spar(2),*,end=900) ls call pgsls(ls) else if (scom .eq. 'draw') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgdraw(xcoord,ycoord) else if (scom .eq. 'move') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgmove(xcoord,ycoord) else if (scom .eq. 'bin') then spar1 = 'CENTER [LOGICAL]' read(spar(2),*,end=900) center bin = 1 else if (scom .eq. 'just') then just = 1 else if (scom .eq. 'axis') then spar1 = 'NAXIS' read(spar(2),*,end=900) naxis else if (scom .eq. 'env') then if (autoscale) then write(*,*) ' Autoscale is on.' write(*,*) ' Axes drawn during plot execution.' else spar1 = 'XMIN XMAX' spar2 = 'YMIN YMAX' read(spar(2),*,end=950) xmin read(spar(3),*,end=950) xmax read(spar(4),*,end=950) ymin read(spar(5),*,end=950) ymax xcoord = (xmax-xmin)/2. ycoord = (ymax-ymin)/2. call pgenv(xmin,xmax,ymin,ymax,just,naxis) just = 0 end if else if (scom .eq. 'autoscale') then if (autoscale) then autoscale = 0 else autoscale = 1 end if else if (scom .eq. 'label') then call pglabel(xlbl,ylbl,toplbl) else if (scom .eq. 'skip') then if (.not. filesw) goto 800 spar1 = 'NLINES' read(spar(2),*,end=900) nlines do jj = 1, nlines read(indata,'(a)') dum end do write(*,'(i5,a,a20)') nlines,' lines skipped in ',fildat else if (scom .eq. 'rewind') then rewind = 1 if (rewind) rewind(indata) else if (scom .eq. 'print') then prnt = 1 else if (scom .eq. 'noprint') then prnt = 0 else if (scom .eq. 'strings') then nmstrg = 1 else if (scom .eq. 'nostrings') then nmstrg = 0 else if (scom .eq. 'vport') then spar1 = 'XLEFT XRIGHT' spar2 = 'YBOT YTOP' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgvport(xleft,xright,ybot,ytop) else if (scom .eq. 'advance') then call pgadvance else if (scom .eq. 'vstand') then call pgvstand else if (scom .eq. 'window') then spar1 = 'X1 X2' spar2 = 'Y1 Y2' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgwindow(xleft,xright,ybot,ytop) else if (scom .eq. 'box') then spar1 = 'XOPT XTICK' spar2 = 'NXSUB YOPT' spar3 = 'YTICK NYSUB' read(spar(2),*,end=980) xopt read(spar(3),*,end=980) xtick read(spar(4),*,end=980) nxsub read(spar(5),*,end=980) yopt read(spar(5),*,end=980) ytick read(spar(5),*,end=980) nysub call pgbox(xopt,xtick,nxsub,yopt,ytick,nysub) else if (scom .eq. 'plot') then spar1 = 'NDATA_PTS' read(spar(2),*,end=900) ntot if (ntot .gt. 500) then ntot = 500 write(*,*) ' Only 500 points can be plotted at a time' end if if (.not. filesw) goto 800 call pgupdt(0) C #== READ IN DATA AND SET X, Y AND ERROR ARRAYS ===# j = 0 do i = 1, ntot if (nmstrg) then read(indata,*,end=850) name,(a(j),j=2,ncol) else read(indata,*,end=850) (a(j),j=1,ncol) end if if (spherical) then x(i) = a(nd)*cos(a(ntheta))*sin(a(nphi)) y(i) = a(nd)*sin(a(ntheta))*sin(a(nphi)) z(i) = a(nd)*cos(a(nphi)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) z2(i) = a(nx2)*z(i)/a(nd) end if else if (polar) then x(i) = a(nd)*cos(a(ntheta)) y(i) = a(nd)*sin(a(ntheta)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) end if else if (hist) then x(i) = a(nx) else x(i) = a(nx) y(i) = a(ny) if (pair) then x2(i) = a(nx2) y2(i) = a(ny2) end if if (rotphi) z(i) = a(nz) end if if (points) then ipts(i) = a(nipts) end if if (errx) then x1(i) = x(i) - a(nerrx1) x2(i) = x(i) + a(nerrx2) end if if (erry) then y1(i) = y(i) - a(nerry1) y2(i) = y(i) + a(nerry2) end if if (text) then if (nmstrg .and. namcol .eq. 1) then txt(i) = name else n(i) = a(namcol) if (n(i) .le. 9) then write(txt(i),'(i1)') n(i) else if (n(i) .le. 99) then write(txt(i),'(i2)') n(i) else if (n(i) .le. 999) then write(txt(i),'(i3)') n(i) end if end if end if if (prnt) print *,i,name,x(i),y(i) if (rottheta) then x(i) = x(i)*cos(theta)+y(i)*sin(theta) y(i) = -x(i)*sin(theta)+y(i)*cos(theta) if (pair) then x2(i) = x2(i)*cos(theta)+y2(i)*sin(theta) y2(i) = -x2(i)*sin(theta)+y2(i)*cos(theta) end if end if if (rotphi) then y(i) = y(i)*cos(phi)+z(i)*sin(phi) if (pair) y2(i) = y2(i)*cos(phi)+z2(i)*sin(phi) end if end do 850 itot = i - 1 write(*,'(i4,a17,a20)') itot,' lines read from ',fildat if (text) then do k = 1,itot call pgtext(x(k),y(k),txt(k)) end do end if if (autoscale) then xmina = x(1) ymina = y(1) xmaxa = x(1) ymaxa = y(1) do ijk = 2, itot if (x(ijk) .gt. xmaxa) xmaxa = x(ijk) if (y(ijk) .gt. ymaxa) ymaxa = y(ijk) if (x(ijk) .lt. xmina) xmina = x(ijk) if (y(ijk) .lt. ymina) ymina = y(ijk) end do plusx = (xmaxa-xmina)*.05 plusy = (ymaxa-ymina)*.05 xmina = xmina - plusx xmaxa = xmaxa + plusx ymina = ymina - plusy ymaxa = ymaxa + plusy call pgenv(xmina,xmaxa,ymina,ymaxa,just,axis) end if if (point) call pgpoint(itot,x,y,ipt) if (points) call pgpoint(itot,x,y,ipts) if (line) call pgline(itot,x,y) if (bin) call pgbin(itot,x,y,center) if (hist) call pghist(itot,x,datmin,datmax,itot,1) if (pair) then do i = 1, itot p(1) = x(i) q(1) = y(i) p(2) = x2(i) q(2) = y2(i) if (dash_inbound) then if (p(1)**2+q(1)**2 .gt. p(2)**2+q(2)**2) then call pgsls(4) else call pgsls(1) end if end if call pgline(2,p,q) end do call pgsls(ls) end if if (errx) then call pgerrx(itot,x1,x2,y,errxt) end if if (erry) then call pgerry(itot,x,y1,y2,erryt) end if pair = 0 spherical = 0 rotphi = 0 rottheta = 0 polar = 0 line = 0 point = 0 points = 0 errx = 0 erry = 0 text = 0 labels = 0 hist = 0 rewind = 0 else if (scom .eq. 'quit') then goto 999 else write(*,*) ' Do not understand ',scom write(iout,*) ' Do not understand ',scom end if go to 100 800 write(*,*) 'No datafile chosen. Use command DATAFILE.' goto 980 900 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(1x,a15,2x,a17)') scom,spar1 go to 980 950 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(1x,a15,2x,a17,2x,a17)') scom,spar1,spar2 go to 980 970 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(1x,a15,2x,a17,2x,a17,2x,a17)') scom,spar1,spar2,spar3 go to 980 980 if (.not.interact) then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' write(*,985) ' Type "commandfile" to return control to ',filnm 985 format(1x,a,a17) end if go to 100 999 call pgupdt(1) call pgend close(indata) if (device .eq. '/ps') then write(*,'(a)') ' Send plot to laserwriter?' read(*,'(a)') querry if (querry(1:1) .eq. 'y') then c kcom = system('print -v PGPLOT.PS') scommnd = 'copy pgplot.ps cuaph1::tta2:' istat=lib$spawn(scommnd,,,,,,,,,,,) if (.not. istat) call lib$stop(%val(istat)) write(*,*) ' Printing' end if end if end subroutine split_line(sline,spar) c === Subroutine to split a string up into individual parts c === when the parts are separated by blanks. character sline*80,spar(10)*25,blank*1 l = len(sline) if (l .eq. 0) then write(*,'(a)') ' Zero length of string ' stop end if k = 1 m = 1 blank = ' ' 100 if (k .gt. 80) goto 900 j = index(sline(k:l),blank) if (j .eq. 1) then k = k + 1 go to 100 else spar(m) = sline(k:k+j-1) k = k + j m = m + 1 go to 100 end if 900 do n = m, 10 spar(n) = ' ' end do return end read(spar(2),*,end=900) nlines do jj = 1, nlines read(indata,'(a)') dum end do write(*,'(i5,a,a20)') nlines,' lines skipped in ',fildat else if (scom .eq. 'rewind') then rewind = 1 pgplot/applications/plotpg/sample.dat010064400040640000322000000162630536111510200205020ustar00tjpcitmbr00000400000017 0.00 1.00 1.70 -0.065 0.0616 14.4705 17.5367 9.1827 5.0000 0.06 1.00 1.70 -0.046 0.0551 11.4355 17.5367 7.8564 5.0000 0.13 1.00 1.70 -0.027 0.0539 10.1048 17.5367 7.3833 5.0000 0.19 1.00 1.70 -0.008 0.0582 10.4782 17.5367 7.7633 5.0000 0.25 1.00 1.70 0.011 0.0678 12.5559 17.5367 8.9964 5.0000 0.38 1.00 1.70 0.049 0.1032 21.8237 17.5367 14.0220 5.0000 0.00 1.00 1.70 -0.065 0.0616 14.4705 17.5367 9.1827 10.0000 0.13 1.00 1.70 -0.032 0.0535 10.5505 17.5367 7.5825 10.0000 0.19 1.00 1.70 -0.015 0.0538 10.0602 17.5367 7.5017 10.0000 0.25 1.00 1.70 0.001 0.0569 10.5498 17.5367 7.9006 10.0000 0.38 1.00 1.70 0.034 0.0720 14.4684 17.5367 10.1368 10.0000 0.50 1.00 1.70 0.067 0.0987 22.3058 17.5367 14.2909 10.0000 0.00 1.00 1.70 -0.065 0.0616 14.4705 17.5367 9.1827 15.0000 0.13 1.00 1.70 -0.034 0.0539 10.8752 17.5367 7.7406 15.0000 0.25 1.00 1.70 -0.002 0.0538 9.9621 17.5367 7.6201 15.0000 0.38 1.00 1.70 0.029 0.0615 11.7315 17.5367 8.8212 15.0000 0.50 1.00 1.70 0.060 0.0770 16.1825 17.5367 11.3436 15.0000 0.63 1.00 1.70 0.091 0.1002 23.3173 17.5367 15.1883 15.0000 0.00 1.00 1.70 -0.065 0.0616 14.4705 17.5367 9.1827 20.0000 0.13 1.00 1.70 -0.037 0.0545 11.2357 17.5367 7.9093 20.0000 0.25 1.00 1.70 -0.009 0.0525 9.8059 17.5367 7.5308 20.0000 0.38 1.00 1.70 0.019 0.0556 10.1811 17.5367 8.0472 20.0000 0.50 1.00 1.70 0.047 0.0639 12.3610 17.5367 9.4584 20.0000 0.63 1.00 1.70 0.075 0.0774 16.3456 17.5367 11.7645 20.0000 0.75 1.00 1.70 0.103 0.0961 22.1364 17.5367 14.9659 20.0000 0.00 0.30 1.70 -0.056 0.0587 13.0279 17.5367 8.5131 5.0000 0.10 0.30 1.70 -0.041 0.0550 11.0348 17.5367 7.6693 5.0000 0.21 0.30 1.70 -0.026 0.0549 10.1580 17.5367 7.3843 5.0000 0.31 0.30 1.70 -0.010 0.0583 10.3975 17.5367 7.6581 5.0000 0.52 0.30 1.70 0.020 0.0756 14.2254 17.5367 9.8822 5.0000 0.73 0.30 1.70 0.051 0.1071 22.5184 17.5367 14.3416 5.0000 0.00 0.30 1.70 -0.056 0.0587 13.0279 17.5367 8.5131 10.0000 0.10 0.30 1.70 -0.043 0.0553 11.3780 17.5367 7.8311 10.0000 0.31 0.30 1.70 -0.016 0.0542 10.0036 17.5367 7.4093 10.0000 0.52 0.30 1.70 0.010 0.0607 11.1964 17.5367 8.2439 10.0000 0.73 0.30 1.70 0.037 0.0748 14.9564 17.5367 10.3350 10.0000 0.89 0.30 1.70 0.057 0.0904 19.4607 17.5367 12.7276 10.0000 0.00 0.30 1.70 -0.056 0.0587 13.0279 17.5367 8.5131 15.0000 0.10 0.30 1.70 -0.044 0.0556 11.5724 17.5367 7.9213 15.0000 0.31 0.30 1.70 -0.018 0.0532 9.9794 17.5367 7.3870 15.0000 0.52 0.30 1.70 0.007 0.0559 10.1432 17.5367 7.7184 15.0000 0.73 0.30 1.70 0.032 0.0637 12.0639 17.5367 8.9154 15.0000 0.89 0.30 1.70 0.054 0.0737 14.9303 17.5367 10.5417 15.0000 0.89 0.30 1.70 0.040 0.0624 11.7066 17.5367 8.9178 20.0000 0.68 0.30 1.70 0.017 0.0561 10.0963 17.5367 7.8700 20.0000 0.47 0.30 1.70 -0.005 0.0531 9.6682 17.5367 7.4085 20.0000 0.26 0.30 1.70 -0.028 0.0535 10.4225 17.5367 7.5331 20.0000 0.13 0.30 1.70 -0.043 0.0555 11.5467 17.5367 7.9284 20.0000 0.00 0.30 1.70 -0.056 0.0587 13.0279 17.5367 8.5131 20.0000 0.00 0.01 1.00 0.289 0.1949 40.1704 39.0527 36.3946 20.0000 0.00 0.02 1.00 0.284 0.1931 39.7756 39.0527 36.2814 20.0000 0.00 0.03 1.00 0.280 0.1918 39.5135 39.0527 36.2193 20.0000 0.00 0.04 1.00 0.277 0.1909 39.3415 39.0527 36.1897 20.0000 0.00 0.06 1.00 0.274 0.1903 39.2301 39.0527 36.1803 20.0000 0.00 0.10 1.00 0.271 0.1899 39.1593 39.0527 36.1831 20.0000 0.00 0.16 1.00 0.270 0.1896 39.1157 39.0527 36.1927 20.0000 0.00 0.25 1.00 0.268 0.1894 39.0898 39.0527 36.2057 20.0000 0.00 0.40 1.00 0.267 0.1893 39.0755 39.0527 36.2201 20.0000 0.00 0.64 1.00 0.265 0.1892 39.0687 39.0527 36.2344 20.0000 0.00 1.01 1.00 0.264 0.1891 39.0664 39.0527 36.2479 20.0000 0.00 0.01 1.17 0.302 0.2017 41.7038 39.0527 36.9215 20.0000 0.00 0.02 1.17 0.295 0.1978 40.8055 39.0527 36.6015 20.0000 0.00 0.03 1.17 0.289 0.1950 40.2006 39.0527 36.4038 20.0000 0.00 0.04 1.17 0.284 0.1932 39.7957 39.0527 36.2867 20.0000 0.00 0.06 1.17 0.280 0.1919 39.5268 39.0527 36.2221 20.0000 0.00 0.10 1.17 0.277 0.1910 39.3501 39.0527 36.1908 20.0000 0.00 0.16 1.17 0.274 0.1903 39.2356 39.0527 36.1805 20.0000 0.00 0.25 1.17 0.272 0.1899 39.1628 39.0527 36.1827 20.0000 0.00 0.40 1.17 0.270 0.1896 39.1178 39.0527 36.1920 20.0000 0.00 0.64 1.17 0.268 0.1894 39.0910 39.0527 36.2049 20.0000 0.00 1.01 1.17 0.267 0.1893 39.0761 39.0527 36.2192 20.0000 0.00 0.01 1.00 0.289 0.1949 40.1704 39.0527 36.3946 20.0000 0.00 0.02 1.00 0.284 0.1931 39.7756 39.0527 36.2814 20.0000 0.00 0.03 1.00 0.280 0.1918 39.5135 39.0527 36.2193 20.0000 0.00 0.04 1.00 0.277 0.1909 39.3415 39.0527 36.1897 20.0000 0.00 0.06 1.00 0.274 0.1903 39.2301 39.0527 36.1803 20.0000 0.00 0.10 1.00 0.271 0.1899 39.1593 39.0527 36.1831 20.0000 0.00 0.16 1.00 0.270 0.1896 39.1157 39.0527 36.1927 20.0000 0.00 0.25 1.00 0.268 0.1894 39.0898 39.0527 36.2057 20.0000 0.00 0.40 1.00 0.267 0.1893 39.0755 39.0527 36.2201 20.0000 0.00 0.64 1.00 0.265 0.1892 39.0687 39.0527 36.2344 20.0000 0.00 1.01 1.00 0.264 0.1891 39.0664 39.0527 36.2479 20.0000 0.00 0.01 1.17 0.302 0.2017 41.7038 39.0527 36.9215 20.0000 0.00 0.02 1.17 0.295 0.1978 40.8055 39.0527 36.6015 20.0000 0.00 0.03 1.17 0.289 0.1950 40.2006 39.0527 36.4038 20.0000 0.00 0.04 1.17 0.284 0.1932 39.7957 39.0527 36.2867 20.0000 0.00 0.06 1.17 0.280 0.1919 39.5268 39.0527 36.2221 20.0000 0.00 0.10 1.17 0.277 0.1910 39.3501 39.0527 36.1908 20.0000 0.00 0.16 1.17 0.274 0.1903 39.2356 39.0527 36.1805 20.0000 0.00 0.25 1.17 0.272 0.1899 39.1628 39.0527 36.1827 20.0000 0.00 0.40 1.17 0.270 0.1896 39.1178 39.0527 36.1920 20.0000 0.00 0.64 1.17 0.268 0.1894 39.0910 39.0527 36.2049 20.0000 0.00 1.01 1.17 0.267 0.1893 39.0761 39.0527 36.2192 20.0000 pgplot/applications/plot10/plot10.f010064400040640000322000001054300536111502700176300ustar00tjpcitmbr00000400000017* Date: Tue, 24 Nov 92 10:20:47 -0700 * From: seeger@gem.LANL.GOV SUBROUTINE PGPLOT10 C C Subroutines to implement high-level functions from the author's C PLOT-10 library, and to interpret calls to PLOT-10 primatives C as corresponding entries in the PGPLOT library. When logarithmic C axes have been defined by calling GRAPH, the PLOT-10 move and draw C calls will automatically take logarithms before plotting. Additional C high-level calls (CONTOUR, CURVE, ERRBAR) which duplicate existing C PGPLOT functions (but which support logarithmic scaling) are included C at the end of this file. C C P. A. Seeger, Los Alamos National Laboratory, Oct. 6, 1992 C C Entries: C ANCHO DASHA DASHR DRAWA DRAWR DRWABS DRWREL C DSHABS DSHREL DWINDO ERASE FINITT GRAPH HDCOPY C HLABEL INITT MOVABS MOVEA MOVER MOVREL OSTRING C PNTABS PNTREL POINTA POINTR RESET SCURSR SEEDW C SEELOC SEETW SETCOLOR SWINDO SYMBOL TERM TWINDO C VCURSR VLABEL VWINDO C C Auxiliary Externals: C CHECK_TEXT LINAXIS LOGAXIS C C PGPLOT Externals: C PGBEGIN PGBOX PGCURSE PGDRAW PGEND PGETXT PGMOVE C PGMTEXT PGNUMB PGPOINT PGQINF PGQPOS PGQVP PGSCH C PGSCI PGSLS PGSLW PGVPORT PGWINDOW C IMPLICIT NONE C C Variables which may occur in calling sequences of entry points CHARACTER TITLE*(*),SUBTITLE*(*),XLABEL*(*),YLABEL*(*),CH*1 REAL XMN,XMX,X,YMN,YMX,Y INTEGER LOGX,LOGY,L,IX,IY,LX,LY C C Local temporary variables: CHARACTER XOPTION*7,YOPTION*8,XFORMAT*6,YFORMAT*6,STRING*12, 1 NEWSTRING*255 REAL XX,XMAJOR,XMINOR,YY,YMAJOR,YMINOR INTEGER I,J,IXMAJOR,IXTICK,IYMAJOR,IYTICK,NC,LL,IX2,IY2 LOGICAL LPOINT C C Local variables to be saved between entries: CHARACTER TERMTYPE*40,HDCPYTYPE*40 REAL ASPECT,X1,X2,XMIN,XMAX,XPERPIX,X0,Y1,Y2,YMIN,YMAX,YPERPIX,Y0 INTEGER LINE,ISYMB,ITERM,IHDCPY LOGICAL XLOG,YLOG,PLOT10 SAVE PLOT10,TERMTYPE,HDCPYTYPE,ITERM,IHDCPY,ASPECT,LINE,ISYMB, 1 X1,X2,XMIN,XMAX,XLOG,XPERPIX,X0, 2 Y1,Y2,YMIN,YMAX,YLOG,YPERPIX,Y0 DATA PLOT10, TERMTYPE,HDCPYTYPE,ITERM,IHDCPY,ASPECT,LINE,ISYMB 1 /.FALSE.,'?', '?', 1, 1, 0.75, -1, -1/ DATA X1,X2, XPERPIX,X0,Y1,Y2, YPERPIX,Y0 1 /0.,1023.,1., 0.,0.,767.,1., 0./ C ENTRY INITT(X) C Initialize graphics terminal device plot10 = .true. call pgbegin(0, termtype(1:iterm), 1, 1) if (termtype.eq.'?') then call pgqinf('dev/type',termtype,iterm) iterm = min0(iterm,index(termtype,'/')+3) end if return C ENTRY HDCOPY C Initialize hardcopy output device call pgbegin(0, hdcpytype(1:ihdcpy), 1, 1) if (termtype.eq.'?') then call pgqinf('dev/type',hdcpytype,ihdcpy) ihdcpy = min0(ihdcpy,index(hdcpytype,'/')+3) end if return C ENTRY ERASE ENTRY RESET C Erase the screen call pgpage ENTRY TERM(IX,IY) return C ENTRY FINITT(X,Y) C Exit graphics call pgend return C C Define graph area in world co-ordinates, to fill the available C viewport area. Place two lines of titles at top, and axis labels C on bottom and left. Draw box with tick marks and labels; logarithmic C if the corresponding LOGX or LOGY value is non-zero. XMN, XMX, YMN, C and YMX will be changed to rounded values. C ENTRY GRAPH(TITLE, SUBTITLE, XLABEL, YLABEL, 1 XMN, XMX, LOGX, YMN, YMX, LOGY) call pgetxt call pgqvp(3,x1,x2,y1,y2) aspect = (y2-y1+1.)/(x2-x1+1.) call pgvport(0.20*aspect, 1.0-0.05*aspect, 0.10, 0.85 ) C call pgsch(2.0) call pgslw(3) call check_text(title,newstring,j,plot10) call pgmtext('T', 2.0, 0.5, 0.5, newstring(1:j)) C call pgsch(1.5) call pgslw(2) call check_text(subtitle,newstring,j,plot10) call pgmtext('T', 1.2, 0.5, 0.5, newstring(1:j)) C call check_text(xlabel,newstring,j,plot10) call pgmtext('B', 2.16, 0.5, 0.5, newstring(1:j)) C call check_text(ylabel,newstring,j,plot10) call pgmtext('L', 4.0, 0.5, 0.5, newstring(1:j)) call pgsch(1.0) call pgslw(1) C xlog = logx.gt.0 ylog = logy.gt.0 if (xlog) then call logaxis(xmn, xmx, ixmajor, ixtick, xminor, xformat) xmin = alog10(xmn) xmax = alog10(xmx) xmajor = 1. ixtick = 9 xoption = 'BCLNTS' if (.not.ylog) xoption = 'ABCLNTS' else call linaxis(xmn, xmx, ixmajor, ixtick, xformat) xmin = xmn xmax = xmx xmajor = (xmax-xmin)/float(ixmajor) xoption = 'BCNTS' if (.not.ylog) xoption = 'ABCNTS' end if C if (ylog) then call logaxis(ymn, ymx, iymajor, iytick, yminor, yformat) ymin = alog10(ymn) ymax = alog10(ymx) ymajor = 1. iytick = 9 yoption = 'BCLNTSV' if (.not.xlog) yoption = 'ABCLNTSV' else call linaxis(ymn, ymx, iymajor, iytick, yformat) ymin = ymn ymax = ymx ymajor = (ymax-ymin)/float(iymajor) yoption = 'BCNTSV' if (.not.xlog) yoption = 'ABCNTSV' end if C call pgwindow(xmin, xmax, ymin, ymax) call pgbox(xoption, xmajor, ixtick, yoption, ymajor, iytick) xperpix = (xmax-xmin)/(x2-x1)/(1.-0.25*aspect) x0 = x1 + 0.20*aspect*(x2-x1) yperpix = (ymax-ymin)/(y2-y1)/0.75 y0 = y1 + 0.10*(y2-y1) C if (xlog) then C Make sure ends of X-axis are labeled if (amod(abs(xmin)+0.01,1.) .gt. 0.02) then i = nint(xmin-0.5) j = nint(xmn/10.**i) call pgnumb(j, i, 0, string, nc) call pgmtext('B', 1.25, 0., 0.5, string(1:nc)) end if if (amod(abs(xmax)+0.01,1.) .gt. 0.02) then i = nint(xmax-0.5) j = nint(xmx/10.**i) call pgnumb(j, i, 0, string, nc) call pgmtext('B', 1.25, 1., 0.5, string(1:nc)) end if end if C if (ylog) then C Make sure ends of Y-axis are labeled if (amod(abs(ymin)+0.01,1.) .gt. 0.02) then i = nint(ymin-0.5) j = nint(ymn/10.**i) call pgnumb(j, i, 0, string, nc) call pgmtext('LV', aspect, 0., 1., string(1:nc)) end if if (amod(abs(ymax)+0.01,1.) .gt. 0.02) then i = nint(ymax-0.5) j = nint(ymx/10.**i) call pgnumb(j, i, 0, string, nc) call pgmtext('LV', aspect, 1., 1., string(1:nc)) end if end if return C C Following entries either move to a new point without drawing, or C move to a new point and draw a single dot or a symbol, accounting C for possibility of log scales. C ENTRY MOVEA(X,Y) lpoint = .false. xx = x yy = y go to 100 C ENTRY MOVABS(IX,IY) lpoint = .false. xx = xmin + xperpix*(float(ix)-x0) yy = ymin + yperpix*(float(iy)-y0) go to 110 C ENTRY POINTA(X,Y) lpoint = .true. ll = -1 xx = x yy = y go to 100 C ENTRY SYMBOL(X,Y,L) lpoint = .true. ll = l xx = x yy = y go to 100 C ENTRY ANCHO(L) lpoint = .true. ll = l call pgqpos(xx,yy) go to 110 C ENTRY PNTABS(IX,IY) lpoint = .true. ll = -1 xx = xmin + xperpix*(float(ix)-x0) yy = ymin + yperpix*(float(iy)-y0) go to 110 C ENTRY MOVREL(IX,IY) lpoint = .false. go to 80 C ENTRY PNTREL(IX,IY) lpoint = .true. ll = -1 80 call pgqpos(xx,yy) xx = xx + xperpix*float(ix) yy = yy + yperpix*float(iy) go to 110 C ENTRY MOVER(X,Y) lpoint = .false. go to 90 C ENTRY POINTR(X,Y) lpoint = .true. ll = -1 90 continue call pgqpos(xx,yy) if (xlog) then xx = (10.**xx) + x else xx = xx + x end if if (ylog) then yy = (10.**yy) + y else yy = yy + y end if 100 continue if (xlog) then if (xx.le.0.) then xx = -38. else xx = alog10(xx) end if end if if (ylog) then if (yy.le.0.) then yy = -38. else yy = alog10(yy) end if end if 110 if (lpoint) then call pgpoint(1, xx, yy, ll) else call pgmove(xx,yy) end if return C C Following entries draw a solid or dashed line from the current C location to a new point, accounting for possibility of log scales. C ENTRY DRAWA(X,Y) ll = 0 xx = x yy = y go to 200 C ENTRY DRWABS(IX,IY) ll = 0 xx = xmin + xperpix*(float(ix)-x0) yy = ymin + yperpix*(float(iy)-y0) go to 210 C ENTRY DASHA(X,Y,L) ll = l xx = x yy = y go to 200 C ENTRY DSHABS(IX,IY,L) ll = l xx = xmin + xperpix*(float(ix)-x0) yy = ymin + yperpix*(float(iy)-y0) go to 210 C ENTRY DRWREL(IX,IY) ll = 0 go to 180 C ENTRY DSHREL(IX,IY,L) ll = l 180 call pgqpos(xx,yy) xx = xx + xperpix*float(ix) yy = yy + yperpix*float(iy) go to 210 C ENTRY DRAWR(X,Y) ll = 0 go to 190 C ENTRY DASHR(X,Y,L) ll = l 190 continue call pgqpos(xx,yy) if (xlog) then xx = (10.**xx) + x else xx = xx + x end if if (ylog) then yy = (10.**yy) + y else yy = yy + y end if 200 continue if (xlog) then if (xx.le.0.) then xx = -38. else xx = alog10(xx) end if end if if (ylog) then if (yy.le.0.) then yy = -38. else yy = alog10(yy) end if end if 210 if (ll.lt.0) then call pgmove(xx,yy) else if (ll.ne.line) then line = mod(ll,5) call pgsls(line+1) end if call pgdraw(xx,yy) end if return C C Set boundaries of viewport or of world co-ordinate system C ENTRY VWINDO(XMN, X, YMN, Y) xmax = xmn+x ymax = ymn+y go to 250 C ENTRY DWINDO(XMN, XMX, YMN, YMX) xmax = xmx ymax = ymx 250 xmin = xmn ymin = ymn call pgwindow(xmin, xmax, ymin, ymax) xperpix = (xmax-xmin)/(x2-x1+1.) x0 = x1 yperpix = (ymax-ymin)/(y2-y1+1.) y0 = y1 return C ENTRY SWINDOW(IX, LX, IY, LY) ix2 = x+lx iy2 = y+ly go to 260 C ENTRY TWINDO(IX, LX, IY, LY) ix2 = lx iy2 = ly 260 call pgqvp(3, x1, x2, y1, y2) call pgvport(float(ix)/(x2-x1), float(ix2)/(x2-x1), 1 float(iy)/(y2-y1), float(iy2)/(y2-y1)) call pgqvp(3, x1, x2, y1, y2) xperpix = (xmax-xmin)/(x2-x1+1.) x0 = x1 yperpix = (ymax-ymin)/(y2-y1+1.) y0 = y1 return C C Write horizontal or vertical text strings C ENTRY HLABEL(TITLE, IX, IY, LX, LY) string = 'B' xx = xperpix*(float(ix)-x0)/(xmax-xmin) ly = nint((y2-y1)/40.) lx = (3*ly)/4 yy = -(float(iy)-y0)/((y2-y1)/40.) go to 300 C ENTRY OSTRING(TITLE,L) call pgqpos(xx,yy) if (l.eq.0) then string = 'B' xx = (xx-xmin)/(xmax-xmin) yy = (yy-ymin)/yperpix/(y2-y1)*40. else string = 'L' xx = (yy-ymin)/(ymax-ymin) yy = (xx-xmin)/yperpix/(y2-y1)*40. end if go to 300 C ENTRY VLABEL(TITLE, IX, IY, LX, LY) string = 'L' xx = yperpix*(float(iy)-y0)/(ymax-ymin) ly = nint((y2-y1)/40.) lx = (3*ly)/4 yy = -(float(iy)-y0)/((y2-y1)/40.) 300 continue call check_text(title,newstring,j,plot10) call pgmtext(string, yy, xx, 0.5, newstring(1:j)) return C C Find ("see") various window parameters C ENTRY SEETW(IX, LX, IY, LY) ix = x1 lx = x2 iy = y1 ly = y2 return C ENTRY SEEDW(XMN,XMX,YMN,YMX) if (xlog) then xmn = 10.**xmin xmx = 10.**xmax else xmn = xmin xmx = xmax end if if (ylog) then ymn = 10.**ymin ymx = 10.**ymax else ymn = ymin ymx = ymax end if return C ENTRY SEELOC(IX,IY) call pgqpos(xx,yy) ix = x0+(xx-xmin)/xperpix iy = y0+(yy-ymin)/yperpix return C ENTRY SETCOLOR(L) call pgsci(l) return C ENTRY SCURSR(L, IX, IY) xx = xmin+xperpix*(float(ix)-x0) yy = ymin+yperpix*(float(iy)-y0) call pgcurse(xx, yy, ch) l = ichar(ch) if (l.gt.0) then ix = x0+(xx-xmin)/xperpix iy = y0+(yy-ymin)/yperpix end if return C ENTRY VCURSR(L, X, Y) if (xlog) then if (x.le.0.) then xx = xmin else xx = alog10(x) end if else xx = x end if if (ylog) then if (y.le.0.) then yy = ymin else yy = alog10(y) end if else yy = y end if call pgcurse(xx,yy,ch) l = ichar(ch) if (l.ne.0) then if (xlog) then x = 10.**xx else x = xx end if if (ylog) then y = 10.**yy else y = yy end if end if return C END C SUBROUTINE CHECK_TEXT(IN,OUT,KOUT,PLOT10_FLAG) C C Decode special characters in PLOT10 string to PGPLOT C IMPLICIT NONE CHARACTER IN*(*),OUT*(*) INTEGER KOUT LOGICAL PLOT10_FLAG C CHARACTER SPECIAL(5)*1,CH2*2,SYMBOL(8)*6 INTEGER I,J,K,IIN,JIN,IOUT,MODE,KMAX DATA SPECIAL/'<', '>', '?', '#', '&'/ DATA SYMBOL/'\(845)', '\(847)', '\(840)', '\(846)', '\(841)', 1 '\(842)', '\(843)', '\(852)'/ C C Omit trailing blanks and nulls do 2 jin=len(in),3,-1 if (in(jin:jin).ne.' ' .and. in(jin:jin).ne.char(0)) go to 3 2 continue C Omit terminal '$' 3 if (in(jin:jin).eq.'$') jin = jin-1 C kmax = len(out) j = 0 k = 0 mode = 2 10 continue j = j+1 if (plot10_flag) then C Look for PLOT10 special characters do 80 i=1,5 if (in(j:j).eq.special(i)) then if ((i.eq.1.or.i.eq.2).and.(i.ne.mode)) then k = k+3 out(k-2:k) = '\f1' else if (i.eq.5) then C Convert next 2 characters to lower case for testing ch2(1:1) = char(ior(ichar(in(j+1:j+1)),32)) ch2(2:2) = char(ior(ichar(in(j+2:j+2)),32)) if (ch2.eq.'ex') then C End of superscript j = j+2 k = k+2 out(k-1:k) = '\d' else if (ch2(1:1).eq.'e') then C Beginning of superscript j = j+1 k = k+2 out(k-1:k) = '\u' else if (ch2.eq.'lx') then C End of subscript j = j+2 k = k+2 out(k-1:k) = '\u' else if (ch2(1:1).eq.'l') then C Beginning of subscript j = j+1 k = k+2 out(k-1:k) = '\d' end if end if mode = i go to 100 end if 80 continue C Not a special case, just keep the character if (mode.eq.3 .or. mode.eq.4) then C Character is Greek, must be preceded with flag k = k+2 out(k-1:k) = '\g' end if k = k+1 if (mode.eq.1 .or. mode.eq.4) then C Character must be lower case out(k:k) = char(ior(ichar(in(j:j)),32)) else C No case modification out(k:k) = in(j:j) end if else C C Look for PGPLOT symbol numbers if (in(j:j).eq.'\') then i = ichar(in(j+1:j+1)) - ichar('0') if (i.ge.1 .and. i.le.8) then j = j+1 k = k+6 out(k-5:k) = symbol(i) go to 100 end if end if C Not symbol number, copy unmodified character to output k = k+1 out(k:k) = in(j:j) end if C 100 if (j.lt.jin .and. k.lt.kmax) go to 10 kout = min0(k,kmax) return END C SUBROUTINE LINAXIS(XONE,XTWO,MAJOR,MINOR,FORMAT) C C SCALE ENDS OF LINEAR AXIS TO ROUNDED NUMBERS C C An axis is defined to include XONE and XTWO, with each end rounded to C be an integer number of units of the form (1, 2, or 5) x 10**n. The C resulting number MAJOR of major divisions will be between 4 and 10, with C MINOR minor divisions in each step. A character string (FORMAT = 'Fww.dd') C is generated to use as the format for labeling the axis. C C P. A. Seeger, Los Alamos National Laboratory, May 24, 1986 C Modified to prevent log of X=0., Aug. 31, 1986 C Use E instead of F format if width > 10, Nov. 21, 1987 C Guard against axis ends > 10**38, Feb. 5, 1990 C C No Externals C IMPLICIT NONE REAL*4 XONE,XTWO,XMIN,XMAX,AXLEN,UNIT INTEGER MAJOR,MINOR,IPOWR,NN,IW,ID CHARACTER*6 FORMAT C XMIN = AMAX1(-0.7E38,AMIN1(XONE,XTWO)) XMAX = AMIN1( 0.7E38,AMAX1(XONE,XTWO)) IF (XMAX.EQ.XMIN) THEN IF (XMAX.LT.0.) THEN XMAX = 0. ELSE IF (XMIN.GT.0.) THEN XMIN = 0. ELSE XMAX = 0.001 END IF END IF AXLEN = XMAX-XMIN IPOWR = NINT(ALOG10(AXLEN)-1.05) UNIT = 10.**IPOWR NN = AXLEN/UNIT IF (NN.GE.15) THEN UNIT=UNIT*5. MINOR=1 IF (NN.LE.30) MINOR=5 ELSE IF (NN.GE.7) THEN UNIT=UNIT*2. MINOR=2 IF (NN.LE.10) MINOR=4 ELSE MINOR=2 IF (NN.LE.4) MINOR=5 END IF C IF (XMIN.GE.0.) THEN XMIN = UNIT*AINT((XMIN+0.01*AXLEN)/UNIT) ELSE XMIN = UNIT*AINT((XMIN+0.01*AXLEN)/UNIT-1.) END IF IF (XMAX.GE.0.) THEN XMAX = UNIT*AINT((XMAX-0.01*AXLEN)/UNIT+1.) ELSE XMAX = UNIT*AINT((XMAX-0.01*AXLEN)/UNIT) END IF C MAJOR = NINT((XMAX-XMIN)/UNIT) IF (XTWO.GT.XONE) THEN XONE = XMIN XTWO = XMAX ELSE XONE = XMAX XTWO = XMIN END IF C ID = MAX0(0,-IPOWR) IF (XMIN.LT.0.) XMIN=-10.*XMIN IF (XMAX.LT.0.) XMAX=-10.*XMAX IPOWR = ALOG10(AMAX1(XMIN,XMAX,1.))+0.001 IW = IPOWR+ID+2 IF (IW.LT.10) THEN WRITE (FORMAT,100) IW,ID 100 FORMAT ('F',I2,'.',I2) ELSE FORMAT = 'E 9. 2' END IF C RETURN END C SUBROUTINE LOGAXIS(XONE,XTWO,MAJOR,MINOR,UNIT,FORMAT) C C SCALE ENDS OF LOGARITHMIC AXIS TO ROUNDED NUMBERS C C An axis is defined to include XONE and XTWO, with each end rounded to C be (1, 2, 3, or 5) x some power of 10. The resulting axis spans MAJOR C decades, including partial decades at one or both ends. The lowest decade C on the axis has MINOR units of size UNIT; if it is a full decade, MINOR = 9 C and UNIT = min(X). A character string (FORMAT = 'Fww.dd') is generated to C use as the format for labeling the axis. C C P. A. Seeger, Los Alamos National Laboratory, May 20, 1986 C Modified to avoid log(X) when X.LE.0., June 17, 1986 C Corrected FORMAT when XMAX<1., June 19, 1987 C Use E instead of F format when width > 10, Nov. 21, 1987 C Guard against axis ends > 10**38, Feb. 5, 1990 C C No Externals C IMPLICIT NONE REAL*4 XONE,XTWO,UNIT,XMIN,XMAX,XLOG,LOG2,LOG3,LOG5,DELTA INTEGER MAJOR,MINOR,IMIN,IMAX,IW,ID CHARACTER*6 FORMAT PARAMETER (LOG2=0.3010300,LOG3=0.4771213,LOG5=0.6989700) C XMIN = AMIN1(XONE,XTWO) XMAX = AMAX1(XONE,XTWO) IF (XMAX.LE.0.) XMAX = 1. IF (XMIN.LE.0.) THEN XMIN = XMAX/1000. ELSE IF (XMAX.GE.1.E38) THEN XMAX = XMIN*1.E6 ELSE XMIN = AMAX1(XMIN,XMAX/1.E24) END IF IF (XMIN.EQ.XMAX) THEN XMAX = XMAX*2. XMIN = XMIN/2. END IF DELTA = 0.01*ALOG10(XMAX/XMIN) C C Look at small end of axis first XLOG = ALOG10(XMIN)+DELTA IMIN = NINT(XLOG-0.5) XMIN = 10.**IMIN UNIT = XMIN XLOG = XLOG-FLOAT(IMIN) IF (XLOG.GT.LOG5) THEN XMIN = 5.*XMIN MINOR = 5 ELSE IF (XLOG.GT.LOG3) THEN XMIN = 3.*XMIN MINOR = 7 ELSE IF (XLOG.GT.LOG2) THEN XMIN = 2.*XMIN MINOR = 8 ELSE MINOR = 9 END IF ID = MAX0(0,-IMIN) C C Now do "same" thing at larger end XLOG = ALOG10(XMAX)-DELTA IMAX = NINT(XLOG-0.5) C Compute total number of decades included MAJOR = IMAX-IMIN+1 XMAX = 10.**IMAX XLOG = XLOG-FLOAT(IMAX) IF (XLOG.LT.LOG2) THEN XMAX = 2.*XMAX ELSE IF (XLOG.LT.LOG3) THEN XMAX = 3.*XMAX ELSE IF (XLOG.LT.LOG5) THEN XMAX = 5.*XMAX ELSE XMAX = 10.*XMAX IMAX = IMAX+1 END IF IF (MAJOR.EQ.1) MINOR=NINT((XMAX-XMIN)/UNIT) C IW = MAX0(0,IMAX)+ID+2 IF (IW.LT.10) THEN WRITE (FORMAT,100) IW,ID 100 FORMAT ('F',I2,'.',I2) ELSE FORMAT = 'E 9. 2' END IF IF (XONE.LT.XTWO) THEN XONE = XMIN XTWO = XMAX ELSE XONE = XMAX XTWO = XMIN END IF C RETURN END C C*********************************************************************** C SUBROUTINE CONTOUR(Z,NRZ,X,NX,Y,NY,CV,NCV,LINE,ZMAX,BITMAP) C C DRAW CONTOURS THROUGH EQUAL VALUES IN AN ARRAY C C From Collected Algorithms from ACM #531 "Contour Plotting [J6]" C by: William V. Snyder, 1978 C Copied from GSAS; transferred to IBM-PC, Dec. 8, 1987 (P.A.Seeger) C Added X, Y, and LINE to calling sequence, Dec. 9, 1987 (PAS) C Restructured, closer to "standard", Dec. 11, 1987 (PAS) C Changed I and J to II and JJ in innermost loop, Dec. 13, 1987 (PAS) C Revised scan pattern from spiral to linear, Aug. 13, 1988 (PAS) C C Externals C DASHA FILL0 LGETMARK MOVEA C C Arguments in calling sequence: C Z R(NRZ,*) Input Array of values to be contoured; nodes must C lie on a topologically rectangular grid. C NRZ I Input Number of rows declared for array Z C X R(*) Input Values of X at grid points of array Z C NX I Input Limit for 1st subscript of Z and X C Y R(*) Input Values of Y at grid points of array Z C NY I Input Limit for 2nd subscript of Z and Y C CV R(*) Input Values of contour levels C NCV I Input No. of contour levels C LINE I(*) Input Line style for each contour level C ZMAX R Input Maximum Z to be considered; grid lines at C a node with value above ZMAX are excluded C BITMAP I(*) Scratch Work area of size (2*NX*NY*NCV+7)/8 bytes C IMPLICIT NONE INTEGER NRZ,NX,NY,NCV,LINE(*) REAL*4 Z(NRZ,*),X(*),Y(*),CV(*),ZMAX INTEGER*4 BITMAP(*) C LOGICAL LGETMARK C C Local variables in CONTOUR: C CVAL R Contour-line value being traced C DELZ R Change in Z when moving 1 cell right or up C IADD I Bit address in BITMAP, starting at zero C IBORDER I Edge of current cell which is on a border C ICV I Index of contour line being traced C IEDGE I Edge of new cell where contour line enters C IFLAG I 1=continue, 2=start at boundary, 3=start in interior, C 4=end at boundary, 5=close contour, 6=none found yet C I,J I Subscripts for search C IJ I(2) Equivalent to I,J C IJMAX I(2) Local copies of NX and NY C I1(2),I2(2),I3(6) Used for subscript computations C II,JJ I Cell with continuation of contour line being traced C INDEX I L-1 + 2*(I-1 + NX*(J-1)) C K I Index of cell edges: 1=bottom, 2=left, 3=top, 4=right C KS I Next cell boundary to cross C L,LL I Orientation flags: 1 is horizontal line, 2 vertical C LBORDER L Flag to show that only border lines are to be done C NI I Number of edges of cell which contour crosses C XINT R(4) Intersections of contour with edges of cell, C in order bottom, left, top, right C XX,YY R Plotting coordinates C Z1,Z2 R Smaller and larger values at segment ends C Z3,Z4 R Values at ends of segment for continuation of contour C REAL*4 XINT(4),Z1,Z2,Z3,Z4,DELZ,CVAL,XX,YY INTEGER I1(2),I2(2),I3(6),I,J,IJ(2),IJMAX(2),K,L,LL,II,JJ,ICV, , IBORDER,IEDGE,IFLAG,NI,KS INTEGER*4 INDEX,MAXINDX,NBITS,IADD LOGICAL LBORDER EQUIVALENCE (IJ(1),I),(IJ(2),J) DATA I1/1,0/, I2/1,-1/, I3/1,0,0,1,1,0/ C IJMAX(1) = NX IJMAX(2) = NY C Clear bit map NBITS = 2*NX*NY*NCV CALL FILL0(BITMAP,NBITS) IFLAG = 6 C C Search every cell in rectangular array for a line segment such that: C 1. the end points are not excluded because Z > ZMAX C 2. current contour <= Z at one end and > Z at other end C 3. no mark has been recorded for this contour on this segment C C Set start at lower left corner of array; do borders first, then interior C LBORDER = .TRUE. MAXINDX = 2*NX*NY-2 100 CONTINUE DO 500 INDEX=0,MAXINDX L = MOD(INDEX,2)+1 I = MOD(INDEX/2,NX)+1 J = (INDEX/2)/NX+1 IF (Z(I,J).LE.ZMAX) THEN C Node itself is within non-excluded range II = I+I1(L) JJ = J+I1(3-L) IF (II.LE.NX .AND. JJ.LE.NY .AND. Z(II,JJ).LE.ZMAX) THEN C Both ends of grid line within range; test if "border" segment IBORDER = 0 IF (IJ(3-L).EQ.1 .OR. 1 Z(I-I1(3-L),J-I1(L)).GT.ZMAX .OR. 2 Z(I+I2(L),J+I2(3-L)).GT.ZMAX) IBORDER = 1 IF (IJ(3-L).GE.IJMAX(3-L) .OR. 1 Z(I+I1(3-L),J+I1(L)).GT.ZMAX .OR. 2 Z(I+1,J+1).GT.ZMAX) IBORDER = IBORDER+2 C 1st time, do ONLY borders (including edges of exclusions) IF (IBORDER.NE.3 .AND. (LBORDER.EQV.(IBORDER.NE.0))) THEN C Examine this line segment this pass Z1 = AMIN1(Z(I,J),Z(II,JJ)) Z2 = AMAX1(Z(I,J),Z(II,JJ)) DELZ = Z(II,JJ)-Z(I,J) DO 400 ICV=1,NCV C Test for all possible contours crossing this grid line; C first check if already done, and set bit to show done IADD = ICV-1 + NCV*INDEX IF (.NOT.LGETMARK(BITMAP,IADD) .AND. 1 CV(ICV).GT.Z1 .AND. CV(ICV).LE.Z2) THEN C Found one we haven't done yet!!! Interpolate. CVAL = CV(ICV) C Decide which edge we are entering cell from IEDGE = L IF (IBORDER.EQ.2) IEDGE = IEDGE+2 XINT(IEDGE) = (CVAL-Z(I,J))/DELZ C Move "pen" to starting point of contour XX = X(I)+XINT(IEDGE)*(X(II)-X(I)) YY = Y(J)+XINT(IEDGE)*(Y(JJ)-Y(J)) IFLAG = 3 IF (LBORDER) IFLAG = 2 CALL MOVEA(XX,YY) C C Follow this contour until it hits boundary or closes on itself II = I JJ = J IFLAG = 1 C "DO WHILE (IFLAG.LT.4)" 200 CONTINUE C If haven't moved to next cell yet, do so IF (IEDGE.EQ.3) JJ = JJ-1 IF (IEDGE.EQ.4) II = II-1 NI = 1 DO 300 K = 1,4 C Test interpolation on other 3 edges IF (K.NE.IEDGE) THEN Z3 = Z(II+I3(K),JJ+I3(K+1)) Z4 = Z(II+I3(K+1),JJ+I3(K+2)) IF (CVAL.GT.AMIN1(Z3,Z4) .AND. . CVAL.LE.AMAX1(Z3,Z4)) THEN C The contour also crosses this edge IF (K.EQ.1 .OR. K.EQ.4) THEN XINT(K) = (CVAL-Z4)/(Z3-Z4) ELSE XINT(K) = (CVAL-Z3)/(Z4-Z3) END IF C Count how many crossings NI = NI+1 KS = K END IF END IF 300 CONTINUE C IF (NI.NE.2) THEN C The contour crosses all four edges of the cell being examined. Choose the C lines top-to-left and bottom-to-right if the interpolation point on the top C edge is less than the interpolation point on the bottom edge. Otherwise, C choose the other pair. This method produces the same result if the axes are C reversed. The contour may close at any edge, but must not cross itself C inside any cell. IF (XINT(3).GE.XINT(1)) THEN KS = 3-IEDGE IF (KS.LE.0) KS = KS+4 ELSE KS = 5-IEDGE END IF END IF C C Determine if the contour will close or run into a boundary at edge KS of the C current cell. IF (KS.LE.2) THEN LL = KS IEDGE = KS+2 ELSE C Must move to adjacent cell before test for closure II = II+I3(KS) JJ = JJ+I3(KS+2) LL = KS-2 IEDGE = KS-2 END IF IADD = ICV-1+NCV*(LL-1+2*(II-1+NX*(JJ-1))) IF (LGETMARK(BITMAP,IADD)) THEN C We've already been here; contour has closed IFLAG = 5 ELSE IF (LL.EQ.2.AND.(II.EQ.1.OR.II.GE.NX) 1 .OR. LL.EQ.1.AND.(JJ.EQ.1.OR.JJ.GE.NY)) THEN C Segment is actual boundary of plot IFLAG = 4 ELSE IF (Z(II-I1(3-LL),JJ-I1(LL)).GT.ZMAX 1 .OR. Z(II+I2(LL),JJ+I2(3-LL)).GT.ZMAX 2 .OR. Z(II+I1(3-LL),JJ+I1(LL)).GT.ZMAX 3 .OR. Z(II+1,JJ+1).GT.ZMAX) THEN C Segment is boundary of an excluded cell IFLAG = 4 END IF C C Draw piece of contour XINT(IEDGE) = XINT(KS) IF (LL.EQ.1) THEN XX = X(II)+XINT(IEDGE)*(X(II+1)-X(II)) YY = Y(JJ) ELSE XX = X(II) YY = Y(JJ)+XINT(IEDGE)*(Y(JJ+1)-Y(JJ)) END IF CALL DASHA(XX,YY,LINE(ICV)) C IF (IFLAG.LT.4) GO TO 200 C Reset II and JJ before looking for next contour II = I+I1(L) JJ = J+I1(3-L) END IF 400 CONTINUE END IF END IF END IF 500 CONTINUE C IF (.NOT.LBORDER) RETURN LBORDER = .FALSE. GO TO 100 END C C CONTOUR SUBROUTINES FOR BIT MANIPULATION C SUBROUTINE FILL0(BITMAP,N) C Fills entire BITMAP with zeros IMPLICIT NONE INTEGER N,I,LOOP INTEGER*4 BITMAP(*) C LOOP = (N-1)/32+1 DO 10 I=1,LOOP BITMAP(I) = 0 10 CONTINUE RETURN END C LOGICAL FUNCTION LGETMARK(BITMAP,N) C Tests bit in BITMAP, and then sets it to one IMPLICIT NONE INTEGER N,NWORD,NBIT INTEGER*4 BITMAP(*) LOGICAL BTEST C NWORD = N/32+1 NBIT = MOD(N,32) LGETMARK = BTEST(BITMAP(NWORD),NBIT) IF (.NOT.LGETMARK) BITMAP(NWORD) = IBSET(BITMAP(NWORD),NBIT) RETURN END C C****************************************************************************** C SUBROUTINE CURVE(X,Y,N,LDASH,ISYM) C C PLOT N POINTS AT (X(I),Y(I)), USING SYMBOL CORRESPONDING TO ISYM, AND C CONNECTING WITH LINE DESCRIBED BY LDASH. C C P. A. Seeger, Los Alamos National Laboratory, May 24, 1986 C INTEGER N,LDASH,ISYM,I REAL*4 X(*),Y(*) C C Externals C DASHA MOVEA SYMBOL C CALL MOVEA(X(1),Y(1)) DO 100 I=1,N CALL DASHA(X(I),Y(I),LDASH) CALL SYMBOL(X(I),Y(I),ISYM) 100 CONTINUE C RETURN END C C****************************************************************************** C SUBROUTINE ERRBARS(X,Y,DY,N,INC,LOGY) C C PLOT ERROR BARS ON EVERY INCth POINT OF AN ARRAY OF N POINTS C (X(I),Y(I)+-DY(I)). LOGY=1 IF ORDINATE IS LOGARITHMIC. C C P. A. Seeger, Los Alamos National Laboratory, Nov. 24, 1987 C IMPLICIT NONE INTEGER N,INC,LOGY,I REAL*4 X(*),Y(*),DY(*),D,R,Y1,Y2 C C Externals C DRAWA MOVEA C DO 100 I=1,N,INC D = ABS(DY(I)) IF (LOGY.EQ.1) THEN IF (Y(I).LE.0.) THEN Y1 = 2.E-38 Y2 = 2.E-38 ELSE IF (D.LT.0.05*Y(I)) THEN Y1 = Y(I)-D Y2 = Y(I)+D ELSE IF (D.LT.88.*Y(I)) THEN R = EXP(D/Y(I)) Y1 = Y(I)/R Y2 = Y(I)*R ELSE Y1 = 2.E-38 Y2 = 1.E+38 END IF ELSE Y1 = Y(I)-D Y2 = Y(I)+D END IF CALL MOVEA(X(I),Y1) CALL DRAWA(X(I),Y2) 100 CONTINUE C RETURN END Number of edges of cell which contour crosses C XINT R(4) Intersections of contour with edges of cell, C in order bottom, left, top, right C XX,YY R Plotting coordinates C Z1,pgplot/applications/aaaread.me010064400040640000322000000004030544620135500171220ustar00tjpcitmbr00000400000017[PGPLOT.APPLICATIONS] pgplot/applications/ This directory contains applications programs based on PGPLOT. The programs have been contributed by various PGPLOT users, and I have not tested them. They may not be portable to all operating systems. Tim Pearson pgplot/applications/document.f010064400040640000322000000155710537102170000172110ustar00tjpcitmbr00000400000017C*DOCUMENT C+ PROGRAM DOCUME C C DOCUMENT extracts documentation from Fortran source code files. C Documentation information is flagged by special characters in C columns 1--3: C C C+ Start of documentation block (this line C is not part of the block) C C C-- End of documentation block (this line C is not part of the block) C C C* Start of a new module; the rest of line C (up to first blank) is the module name. If no such delimiter C is encountered, the module name is the file name (excluding C disk, directory, type, version, etc.) C C Usage: C DOCUMENT uses three control parameters: C INPUT: the name of the input disk file(s), which may include C VMS wild-cards; must be specified. C LISTFILE: the name for the output listing; default |SYS$OUTPUT|. C TYPE: specify the format for the output file as C `LIST' (default) C `INDEX' for index of modules only C `HELP' for a VMS help file C `TEX' for TeX code. C C History: C 1.0: 1985 May 21 -- (T. J. Pearson, VAX-11 Fortran). C 1.1: 1985 Oct 8 -- change delimiters to VLBA standard. C 1.2: 1985 Oct 8 -- add TYPE parameter. C 1.4: 1987 May 19 -- add TeX option. C 1.5: 1987 Nov 12 -- add INDEX option. C 2.0: 1992 Jun 16 -- remove use of Keyin. C C Subroutines required: C |LIB$FIND_FILE| (VMS) wild-card expansion. C |LIB$SYS_GETMSG| (VMS) system error message. C---------------------------------------------------------------------- C C Constants. C CHARACTER*(*) VERSN INTEGER INC,OUTC,INDAT,PR INTEGER RMS$_NMF PARAMETER (VERSN='2.0 - 1992 Jun 16') PARAMETER (INC=5,OUTC=6,INDAT=1,PR=2) C ! I/O unit numbers PARAMETER (RMS$_NMF = '000182CA'X) C ! VMS code C C Variables. C CHARACTER INPFIL*128, INDSN*128, LISFIL*128 CHARACTER TEXT*128, TYPE*16, DEFNAM*32 CHARACTER LFMT*16 INTEGER L1, LINP, LLIS, NFIL INTEGER CONTXT, I, IER, J, L, LDSN, MODE, NREC LOGICAL PROPEN, COPY, HELP, TEX, INDX C C External functions. C INTEGER LIB$FIND_FILE, LEN1 LOGICAL ISTERM C C Formats. C 600 FORMAT(' DOCUMENT extracts documentation from source code'/ 1 ' (Version ',A,')'/) 605 FORMAT(' Control parameters (INPUT, LISTFILE, TYPE;', 1 ' end with /):') 610 FORMAT(1X,A,T20,A) 620 FORMAT(72('-')) 650 FORMAT(' ++WARNING++ No documentation found in input file(s).') C----------------------------------------------------------------------- C C Introduction. C WRITE (OUTC,600) VERSN C C Control parameters. C WRITE (OUTC, '('' Input file: '',$)') READ (INC, '(A)', ERR=80, END=80) INPFIL LINP = LEN1(INPFIL) WRITE (OUTC, '('' Output file: '',$)') READ (INC, '(A)', ERR=80, END=80) LISFIL LLIS = LEN1(LISFIL) WRITE (OUTC, '('' Type (LIST, INDEX, HELP, TEX): '',$)') READ (INC, '(A)', ERR=80, END=80) TYPE HELP = TYPE(1:1).EQ.'H' .OR. TYPE(1:1).EQ.'h' TEX = TYPE(1:1).EQ.'T' .OR. TYPE(1:1).EQ.'t' INDX = TYPE(1:1).EQ.'I' .OR. TYPE(1:1).EQ.'i' IF (HELP) THEN DEFNAM = 'DOCUMENT.HLP' LFMT = '(2X,A)' ELSE IF (TEX) THEN DEFNAM = 'DOCUMENT.TEX' LFMT = '(A)' ELSE DEFNAM = 'DOCUMENT.DOC' LFMT = '(A)' END IF C C Expand wild cards and open input file. C PROPEN = .FALSE. CONTXT = 0 NFIL = 0 20 NFIL = NFIL+1 IER = LIB$FIND_FILE(INPFIL(1:LINP),INDSN,CONTXT) IF (IER.EQ.RMS$_NMF) GOTO 80 IF (MOD(IER,2).NE.1) THEN CALL LIB$SYS_GETMSG(IER,L,TEXT) WRITE (OUTC,'(1X,A)') TEXT(1:L) GOTO 80 END IF OPEN (UNIT=INDAT, FILE=INDSN, STATUS='OLD', READONLY, 1 FORM='FORMATTED', ERR=80) INQUIRE (UNIT=INDAT, NAME=INDSN) LDSN = MIN(132,LEN1(INDSN)) C C Open output file (first time only). C IF (.NOT.PROPEN) THEN OPEN (UNIT=PR, FILE=LISFIL(1:LLIS), STATUS='NEW', 1 CARRIAGECONTROL='LIST', IOSTAT=IER, 2 DEFAULTFILE=DEFNAM, FORM='FORMATTED') IF (IER.NE.0) THEN WRITE (OUTC,'(1X,2A)') 'Cannot open LISTFILE, ', 1 LISFIL(1:LLIS) CLOSE (UNIT=INDAT) GOTO 80 END IF PROPEN = .TRUE. END IF C C Write out file name. C IF (INDX) THEN WRITE (PR, '(/A/)') INDSN(1:LDSN) END IF C C Read input file and look for flags. C NREC = 0 COPY = .FALSE. 30 READ (INDAT,END=70,ERR=70, FMT='(Q,A)') L,TEXT IF (L.GE.3 .AND. TEXT(1:3).EQ.'C--') THEN IF (COPY.AND.TEX) WRITE (UNIT=PR, FMT='(A)') '\endtt}' COPY = .FALSE. END IF IF (COPY) THEN L1 = 1 IF (TEXT(1:2).EQ.'C ') L1 = 3 IF (L1.GT.L) L = L1 WRITE (UNIT=PR, FMT=LFMT) TEXT(L1:L) END IF IF (L.GE.2 .AND. TEXT(1:2).EQ.'C+') THEN IF ((.NOT.COPY).AND.TEX) 1 WRITE (UNIT=PR, FMT='(A)') '{\eightpoint\begintt' COPY = .TRUE. .AND. (.NOT.INDX) END IF IF (L.GT.2 .AND. TEXT(1:2).EQ.'C*') THEN IF (HELP) THEN WRITE (UNIT=PR, FMT='(I1,1X,A)') 2,TEXT(3:L) ELSE IF (TEX) THEN WRITE (UNIT=PR, FMT='(/3A)') '\module{',TEXT(3:L),'}' ELSE IF (INDX) THEN WRITE (UNIT=PR, FMT='(A)') TEXT(3:L) ELSE WRITE (UNIT=PR, FMT='(/)') WRITE (UNIT=PR, FMT=620) WRITE (UNIT=PR, FMT='(2A)') 'Module: ',TEXT(3:L) * WRITE (UNIT=PR, FMT='(2A)') 'File: ',INDSN(1:LDSN) WRITE (UNIT=PR, FMT=620) WRITE (UNIT=PR, FMT='(:)') END IF END IF NREC = NREC+1 GOTO 30 C C End of file: go and find another one. C 70 CLOSE (UNIT=INDAT) GOTO 20 C C End of job: close output file if open, else give message. C 80 IF (PROPEN) THEN CLOSE (UNIT=PR) ELSE WRITE (UNIT=OUTC,FMT=650) END IF C END C*LEN1 -- length of string excluding trailing blanks C+ INTEGER FUNCTION LEN1(S) CHARACTER*(*) S C C Find the length of a character string excluding trailing blanks. C A blank string returns a value of 0. C C Argument: C S (input) : character string. C C Returns: C LEN1 : number of characters in S, excluding trailing C blanks, in range 0...LEN(S). A blank string C returns a value of 0. C C Subroutines required: C None C C Fortran 77 extensions: C None C C History: C 1987 Nov 12 - TJP. C----------------------------------------------------------------------- INTEGER I C IF (S.EQ.' ') THEN LEN1 = 0 ELSE DO 10 I=LEN(S),1,-1 LEN1 = I IF (S(I:I).NE.' ') GOTO 20 10 CONTINUE LEN1 = 0 20 CONTINUE END IF END expansion. C |LIB$SYS_GETMSG| (VMS) system error message. C---------------------------------------------------------------------- C pgplot/applications/gmfplot.f010064400040640000322000000237100537102172200170410ustar00tjpcitmbr00000400000017 PROGRAM GMFPLOT C----------------------------------------------------------------------- C Translate a metafile. C----------------------------------------------------------------------- CHARACTER*8 TYPE CHARACTER*128 DEVICE,FILE INTEGER GROPEN integer*2 chunk,i,j real xcp,ycp logical prompt, debug, grchkt common /metafile_status/ xcp, ycp, prompt, debug common /pltid/ id C C Find and open the metafile. C IER = LIB$GET_FOREIGN(FILE,'Input file: ',L) IF (IER.NE.1) CALL EXIT(IER) IF (L.LT.1) CALL EXIT I = 1 DO WHILE (I.LE.L .AND. FILE(I:I).LE.' ') I = I+1 END DO FILE = FILE(I:) I = 1 DO WHILE (I.LE.L .AND. FILE(I:I).NE.' ' .AND. FILE(I:I).NE.'/') I = I+1 END DO DEVICE = FILE(I:) FILE = FILE(:I-1) OPEN (UNIT=1,NAME=FILE,READONLY,SHARED,STATUS='OLD', 1 DEFAULTFILE='GRAPHICS.GMF', 2 FORM='UNFORMATTED',RECORDTYPE='FIXED',RECL=180, 3 IOSTAT=IER) IF (IER.NE.0) THEN CALL ERRSNS(,IER,IES,,IET) IF (IES.NE.0) CALL EXIT(IES) IF (IER.NE.0) CALL EXIT(IER) CALL EXIT(IET) END IF C C Find and open the output plot device. C IER = 1 IF (DEVICE.EQ.' ') IER = LIB$GET_INPUT( 1 DEVICE,'Graphics device/type: ',L) IF (IER.NE.1) CALL EXIT(IER) IER = GROPEN(0,0,DEVICE,ID) IF (IER.NE.1) CALL EXIT(IER) C C! call grinqtyp(type,prompt) call grqtyp(type,prompt) prompt = prompt .and. grchkt('sys$command') debug = type(1:4).eq.'NULL' C C Read and translate the metafile. C chunk = 0 do while (chunk.ne.'8100'X) call getchunk(chunk) if (chunk.lt.0) then call dochunk(chunk) else i = chunk xcp = i call getchunk(j) if (j.ge.0) then ycp = j D type *,' MOVE',i,j call grmova(xcp,ycp) else j = ibclr(j,15) ycp = j D type *,' DRAW',i,j call grlina(xcp,ycp) end if end if end do call grclos end subroutine dochunk(chunk) C----------------------------------------------------------------------- C GMFPLOT: interpret a non-positioning Metafile command. All C non-positioning commands consist of a command chunk and zero or more C parameter chunks. A non-positioning command has a '1' in the C high-order bit (15) of the command chunk. Bits 14-12 indicate one C of 8 classes of Metafile commands; bits 11-8 indicate one of 16 C commands within the class; and bits 7-0 give the number of 16-bit C parameter chunks that follow. DOCHUNK interprets the command chunk C and reads and interprets the following parameter chunks. C C Argument: C CHUNK (input, integer*2): the command chunk. C C T. J. Pearson, 4-Jun-1984. C----------------------------------------------------------------------- implicit none character*4 bells parameter (bells=char(7)//char(7)//char(7)//char(7)) integer*2 dummy,chunk,ci,cr,cg,cb,ix,iy integer attrib,c,i,j,k,l logical file_open, picture_open integer picture_number, marker character*4 nerd,junk real xcp,ycp real px(512),py(512) logical prompt,debug integer id real xscale common /metafile_status/ xcp, ycp, prompt, debug common /pltid/ id,xscale C 1000 format (1X,Z4.4,1X,A,T40,5I6) C C Separate chunk into command class (c), command-index C (i), and number of parameter chunks (j). C c = ibits(chunk,12,3) i = ibits(chunk,8,4) j = ibits(chunk,0,8) D type '(1X,Z4.4,3I6)',chunk,c,i,j goto (100,101,102,103,104), c+1 goto 900 C C Control commands --- class 0. C 100 if (i.eq.0) then ! BEGIN_METAFILE j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'BEGIN_METAFILE',dummy if (dummy.ne.1) then call lib$put_output('%GMFPLOT, "BEGIN_METAFILE" '// 1 'command does not request 15-bit precision') call exit(44) end if if (file_open) then call lib$put_output('%GMFPLOT, "BEGIN_METAFILE" '// 1 'command is misplaced') call exit(44) end if file_open = .true. call scale(32767,32767) else if (i.eq.1) then ! END_METAFILE if (debug) write (6,1000) chunk,'END_METAFILE' file_open = .false. else if (i.eq.2) then ! DEFINE_NDC_SPACE j = j-3 call getchunk(ix) call getchunk(iy) call getchunk(dummy) if (debug) write (6,1000) chunk,'DEFINE_NDC_SPACE', 1 ix,iy,dummy call scale(ix,iy) else if (i.eq.4) then ! NO_OPERATION continue else goto 900 end if goto 800 C C Metafile picture commands --- class 1. C 101 if (i.eq.0) then ! BEGIN_PICTURE j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'BEGIN_PICTURE',dummy picture_number = dummy picture_open = .true. if (prompt.and.picture_number.gt.1) then call lib$get_input(junk,bells,L) end if call grpage xcp = 0.0 ycp = 0.0 marker = 1 else if (i.eq.1) then ! END_PICTURE if (debug) write (6,1000) chunk,'END_PICTURE' picture_open = .false. call grterm else goto 900 end if goto 800 C C Mode and marker commands --- class 2. C 102 if (i.eq.0) then ! SET_2D_MODE if (debug) write (6,1000) chunk,'SET_2D_MODE' continue else if (i.eq.1) then ! SET_3D_MODE if (debug) write (6,1000) chunk,'SET_3D_MODE' call lib$put_output( 1 '%GMFPLOT, SET_3D_MODE command not allowed') call exit(44) else if (i.eq.2) then ! SET_MARKER_SYMBOL j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_MARKER_SYMBOL',dummy marker = dummy else if (i.eq.3) then ! OUTPUT_SELECTED_MARKER if (debug) write (6,1000) chunk,'OUTPUT_SELECTED_MARKER' C! call grmarker(marker,.false.,1,xcp,ycp) call grmker(marker,.false.,1,xcp,ycp) else if (i.eq.4) then ! OUTPUT_SPECIFIC_MARKER j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'OUTPUT_SPECIFIC_MARKER',dummy attrib = dummy C! call grmarker(attrib,.false.,1,xcp,ycp) call grmker(attrib,.false.,1,xcp,ycp) else if (i.eq.8) then ! SET_MARKER_SIZE j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_MARKER_SIZE',dummy call grsetc(id,xscale*dummy) else if (i.eq.7) then ! DRAW_POLYGON j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'DRAW_POLYGON',dummy if (dummy.gt.512) then call lib$put_output('%GMFPLOT, "DRAW_POLYGON" '// 1 'command has more than 512 vertices') end if k = min(dummy,512) do i=1,k call getchunk(ix) call getchunk(iy) px(i) = ibclr(ix,15) py(i) = ibclr(iy,15) end do call grfa(k,px,py) else goto 900 end if goto 800 C C Text commands --- class 3. C 103 if (i.eq.1) then ! SET_CHARACTER_FONT j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_CHARACTER_FONT',dummy attrib = dummy call grsfnt(attrib) else goto 900 end if goto 800 C C Attribute commands --- class 4. C 104 if (i.eq.0) then ! DEFINE_COLOR_INDEX j = j-4 call getchunk(ci) call getchunk(cr) call getchunk(cg) call getchunk(cb) if (debug) write (6,1000) chunk, 1 'DEFINE_COLOR_INDEX',ci,cr,cg,cb attrib = ci call grscr(attrib,cr/32767.,cg/32767.,cb/32767.) else if (i.eq.1) then ! SET_COLOR j = j-1 call getchunk(dummy) attrib = dummy if (debug) write (6,1000) chunk,'SET_COLOR',dummy C! call grsetcol(attrib) call grsci(attrib) else if (i.eq.2) then ! SET_INTENSITY j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_INTENSITY',dummy attrib = dummy call grsetli(attrib) else if (i.eq.3) then ! SET_LINESTYLE j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_LINESTYLE',dummy attrib = dummy C! call grsetls(attrib) call grsls(attrib) else if (i.eq.4) then ! SET_LINEWIDTH j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_LINEWIDTH',dummy attrib = dummy C! call grsetlw(attrib) call grslw(attrib) else if (i.eq.5) then ! SET_PEN j = j-1 call getchunk(dummy) if (debug) write (6,1000) chunk,'SET_PEN',dummy attrib = dummy call grsetpen(attrib) else goto 900 end if goto 800 C C Report illegal command. C 900 call grterm write (nerd,'(Z4.4)') chunk call lib$put_output('%GMFPLOT, unrecognized command '//nerd) goto 800 C C Skip any additional chunks which have not been C decoded while interpreting the command. C 800 do k=1,j call getchunk(dummy) end do return end subroutine getchunk(chunk) integer*2 chunk,buffer(360) integer i data i/360/ if (i.eq.360) then read(unit=1,end=10) buffer i = 1 else i = i+1 end if chunk = buffer(i) return 10 chunk = '8100'X ! END_METAFILE return end subroutine scale (ix,iy) C----------------------------------------------------------------------- C GMFPLOT: scale output device so that a rectangle with metafile C coordinates (0...ix), (0...iy) is mapped onto the largest possible C rectangle with the same aspect ratio on the output device. C----------------------------------------------------------------------- implicit none integer*2 ix,iy integer id real xdef,ydef,xmax,ymax,xperin,yperin real xsize_inches,ysize_inches,s real xorg,yorg,xscale,yscale common /pltid/ id,xscale C C Obtain output device parameters. C call grsize(id,xdef,ydef,xmax,ymax,xperin,yperin) C C Size of output view surface in inches. C xsize_inches = xdef/xperin ysize_inches = ydef/yperin C C 's' is the scale in inches-per-metafile-unit C which produces the largest plot which fits on the C output view surface. C s = min(xsize_inches/ix,ysize_inches/iy) C C 'xscale' and 'yscale' are the corresponding scales C in device-units-per-metafile-unit. C xscale = s*xperin yscale = s*yperin C C 'xorg' and 'yorg' are offsets to center the C plot on the view surface. One of these will be zero. C xorg = xperin*(xsize_inches - ix*s)/2.0 yorg = yperin*(ysize_inches - iy*s)/2.0 C C Set the transform parameters. C call grtran(id,xorg,yorg,xscale,yscale) D type *,'Max size: ',xsize_inches,ysize_inches D type *,'Actual size:',ix*s,iy*s D TYPE *,xorg,yorg,xscale,yscale return end oning Metafile command. All C non-positioning commands cpgplot/applications/pgattrib.inc010064400040640000322000000020440537102173400175310ustar00tjpcitmbr00000400000017C----------------------------------------------------------------------- C PGATTRIB.FOR C Symbolic names for PGPLOT attributes 22-Nov-1986 C----------------------------------------------------------------------- C Color index: INTEGER BLACK, WHITE, RED, GREEN, BLUE, CYAN, MAGENT, YELLOW PARAMETER (BLACK=0) PARAMETER (WHITE=1) PARAMETER (RED=2) PARAMETER (GREEN=3) PARAMETER (BLUE=4) PARAMETER (CYAN=5) PARAMETER (MAGENT=6) PARAMETER (YELLOW=7) C Line style: INTEGER FULL, DASHED, DOTDSH, DOTTED, FANCY PARAMETER (FULL=1) PARAMETER (DASHED=2) PARAMETER (DOTDSH=3) PARAMETER (DOTTED=4) PARAMETER (FANCY=5) C Character font: INTEGER NORMAL, ROMAN, ITALIC, SCRIPT PARAMETER (NORMAL=1) PARAMETER (ROMAN=2) PARAMETER (ITALIC=3) PARAMETER (SCRIPT=4) C Fill-area style: INTEGER SOLID, HOLLOW PARAMETER (SOLID=1) PARAMETER (HOLLOW=2) C----------------------------------------------------------------------- pgplot/sys_cygwin/Makefile.dlls010064400040640000322000000052040670136637400173420ustar00tjpcitmbr00000400000017# Makefile.dll # # David Billinghurst # Comalco Research Centre, Melbourne, Australia # David.Billinghurst@riotinto.com.au # # Use this to build pgplot as a dll using cygwin b20.1 # # Based on Mumit Khan's dllhelper-2.5 package. # See http://www.xraylith.wisc.edu/~khan/software/gnu-win32/dllhelpers.html AS = as DLLTOOL = dlltool -v DLLWRAP = dllwrap -v DLL_NAME = pgplot.dll DLL_EXP_LIB = libpgplot.a DLL_EXP_DEF = pgplot.def # #The default entry point defined by dllwrap; the default user callback # is DllMain, and there is stub in dllinit.c. DLL_LDFLAGS = # any extra libraries that your DLL may depend on. DLL_LDLIBS = $(LIBS) DLL_OBJS = $(PG_ROUTINES) $(PG_NON_STANDARD) $(GR_ROUTINES) \ $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES) DLLWRAP_FLAGS = --export-all --output-def $(DLL_EXP_DEF) \ --implib $(DLL_EXP_LIB) \ --driver-name $(FCOMPL) $(DLL_NAME) $(DLL_EXP_DEF) $(DLL_EXP_LIB): $(DLL_OBJS) $(DLLWRAP) $(DLLWRAP_FLAGS) -o $(DLL_NAME) \ $(DLL_OBJS) $(DLL_LDFLAGS) $(DLL_LDLIBS) CPG_SOURCE := cpgarro.c cpgask.c cpgaxis.c cpgband.c cpgbbuf.c \ cpgbeg.c cpgbin.c cpgbox.c cpgcirc.c cpgclos.c cpgconb.c cpgconf.c \ cpgconl.c cpgcons.c cpgcont.c cpgctab.c cpgcurs.c cpgdraw.c cpgebuf.c \ cpgend.c cpgenv.c cpgeras.c cpgerr1.c cpgerrb.c cpgerrx.c cpgerry.c \ cpgetxt.c cpggray.c cpghi2d.c cpghist.c cpgiden.c cpgimag.c cpglab.c \ cpglcur.c cpgldev.c cpglen.c cpgline.c cpgmove.c cpgmtxt.c cpgncur.c \ cpgnumb.c cpgolin.c cpgopen.c cpgpage.c cpgpanl.c cpgpap.c cpgpixl.c \ cpgpnts.c cpgpoly.c cpgpt.c cpgpt1.c cpgptxt.c cpgqah.c \ cpgqcf.c cpgqch.c cpgqci.c cpgqcir.c cpgqclp.c cpgqcol.c cpgqcr.c \ cpgqcs.c cpgqdt.c cpgqfs.c cpgqhs.c cpgqid.c cpgqinf.c cpgqitf.c \ cpgqls.c cpgqlw.c cpgqndt.c cpgqpos.c cpgqtbg.c cpgqtxt.c cpgqvp.c \ cpgqvsz.c cpgqwin.c cpgrect.c cpgrnd.c cpgrnge.c cpgsah.c cpgsave.c \ cpgscf.c cpgsch.c cpgsci.c cpgscir.c cpgsclp.c cpgscr.c cpgscrl.c \ cpgscrn.c cpgsfs.c cpgshls.c cpgshs.c cpgsitf.c cpgslct.c cpgsls.c \ cpgslw.c cpgstbg.c cpgsubp.c cpgsvp.c cpgswin.c cpgtbox.c cpgtext.c \ cpgtick.c cpgunsa.c cpgupdt.c cpgvect.c cpgvsiz.c cpgvstd.c cpgwedg.c \ cpgwnad.c cpgplot.h: $(PG_SOURCE) pgbind ./pgbind $(PGBIND_FLAGS) -h -w $(PG_SOURCE) CDLL_NAME = cpgplot.dll CDLL_EXP_LIB = libcpgplot.a CDLL_EXP_DEF = cpgplot.def CDLL_OBJS = $(CPG_SOURCE:.c=.o) CDLL_LDLIBS = -L. -lpgplot CDLLWRAP_FLAGS = --export-all --output-def $(CDLL_EXP_DEF) \ --implib $(CDLL_EXP_LIB) \ --driver-name $(CCOMPL) $(CDLL_NAME) $(CDLL_EXP_DEF) $(CDLL_EXP_LIB): $(CDLL_OBJS) $(DLLWRAP) $(CDLLWRAP_FLAGS) -o $(CDLL_NAME) \ $(CDLL_OBJS) $(DLL_LDFLAGS) $(CDLL_LDLIBS) %.o: %.c $(CCOMPL) -c $(CFLAGC) $(*).c pgplot/sys_cygwin/aaaread.me010064400040640000322000000032260670137136400166430ustar00tjpcitmbr00000400000017pgplot/sys_cygwin The files in this directory are for use with Cygnus cygwin and gcc/g77. It works under windows 95 and Windows NT 4.0. Built using cygwin beta 20.1 http://sourceware.cygnus.com/ egcs-1.1.2 http://www.xraylith.wisc.edu/~khan/software/gnu-win32/ X11R6.4 libraries http://dao.gfc.nasa.gov/software/grads/X11R6.4/ cgm driver http://www.geocities.com/HeartlandHills/8328/software.html ---------------------------------------------------------------------------- PGPLOT can be built on cygwin b20.1 system using the Unix installation instructions o create a build directory o copy drivers.list from the source directory o edit it to include the drivers you want o makemake ...... o make o etc I have built also built pgplot as a dll, using Mumit Khan's examples from http://www.xraylith.wisc.edu/~khan/software/gnu-win32/dllhelpers.html Once you have a makefile you need to: copy Makefile.dlls into the build directory remove the rules for libpgplot.a and libcpgplot.a from the makefile add the line "include Makefile.dlls" to the Makefile make the rules for the C bindings aren't quite right. You need to do: make cgplot.h make libcpgplot.a copy libpgplot.a and libcpgplot.a to an appropriate /lib directory (/usr/local/lib?) copy pgplot.dll and cpgplot.dll to a directory in your path (/usr/local/bin?) (hope like hell it works for you) I strip the dll and any .exe files. ---------------------------------------------------------------------------- David Billinghurst David.Billinghurst@riotinto.com.au 26 March 1999 ____________________________________________________________________________ pgplot/sys_cygwin/g77_gcc.conf010064400040640000322000000075060667637642400170530ustar00tjpcitmbr00000400000017# Cygnus cygwin32 b19 using # GNU g77 FORTRAN compiler # Gnu gcc C compiler. # # David Billinghurst (David.Billinghurst@riotinto.com.au) #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6.4/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall -O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2 -DNOMALLOCH -I." # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-Wall -O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6.4/lib -lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt " # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-ltk -ltcl -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_epix2/aaaread.me010064400040640000322000000024440634465374700164060ustar00tjpcitmbr00000400000017The *.conf files in this directory are for use with Control Data EP/IX 2.x. The installation was performed with The Fortran 3.18 compiler, the C 3.18 compiler, and RISCWindows 5.0 on an EP/IX 2.2.1aa system. The following drivers/devices were tested: GIDRIV/GIF GIDRIV/VGIF NUDRIV/NULL PSDRIV/PS PSDRIV/VPS PSDRIV/CPS PSDRIV/VCPS TTDRIV/TEK4010 TTDRIV/XTERM TTDRIV/TK4100 XWDRIV/XWINDOW XWDRIV/XSERVE XMDRIV/XMOTIF The following drivers/devices failed to compile MFDRIV/FILE Line 159 of mfdriv produces runtime error #156: "fixed record on sequential file not allowed" The inability to use the metafile format is no great loss, as the program gmfplot is very VAX-specific and requires porting as well. When compiling programs (not the libraries), you may get the messages ld: The shared object /usr/lib/libmld.so did not resolve any symbols. You may want to remove it from your link line. ld: The shared object /usr/lib/libm.so did not resolve any symbols. You may want to remove it from your link line. ld: The shared object /usr/X11/lib/libXext.so did not resolve any symbols. You may want to remove it from your link line. Ignore them. Ed Skochinski: ed.skochinski@cdc.com pgplot/sys_epix2/f77_cc.conf010064400040640000322000000102340635525712600164110ustar00tjpcitmbr00000400000017# The EP/IX f77 3.18 FORTRAN compiler and cc 3.18 C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="$XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include $XINCL" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -KPIC -O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -KPIC -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11/lib -lX11 -lm -lsocket -lnsl -lmld -lgen -lc -lucb -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/X11/lib -lXm -lXt -lXext $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="echo ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="\$SYSDIR" FFLAGC="-u -KPIC -O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to uspgplot/sys_freebsd/iand.c010064400040640000322000000000560573342526000161300ustar00tjpcitmbr00000400000017int iand_ (int *a, int *b) { return *a & *b;} pgplot/sys_freebsd/f77_cc.conf010064400040640000322000000100210656367443400167740ustar00tjpcitmbr00000400000017# FreeBSD using f77 and cc. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6/lib -lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_freebsd/aaaread.me010064400040640000322000000012170573342546700167630ustar00tjpcitmbr00000400000017Date: Tue, 21 Mar 95 00:10:56 +0100 From: jmz@cabri.obs-besancon.fr (Jean-Marc Zucconi) Here are the required files to build pgplot (5.01) on FreeBSD (sys_freebsd): iand.c f77_cc.conf This only builds static libs. FreeBSD supports shared libs, but building pgplot with shared libs would require changes in the makemake script. ~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~ Jean-Marc Zucconi | jmz@cabri.obs-besancon.fr Observatoire de Besancon | F 25010 Besancon cedex | PGP Key: finger jmz@cabri.obs-besancon.fr ========================================================================= pgplot/sys_fujitsu/aaaread.me010064400040640000322000000100610622624116400170230ustar00tjpcitmbr00000400000017pgplot/sys_fujitsu The configuration files in this directory are for PGPLOT v5.1.0 on the Fujitsu VP2200 under UXP/M and VPP300 under UXP/V. uxpm_frt_cc.conf: VP2200, UXP/M uxpv_frt_cc.conf: VPp300, UXP/V The configuration files and the following notes are from David Singleton (Australian National University Supercomputer Facility) , based on earlier work by Roger A. Edberg . Testing of version 5.1.0 on VP2200 under UXP/M ============================================== The following are notes on testing pgplot5.10 on the Fujitsu VP2200 under UXP/M. Basically, no changes since previous port by Roger Edberg. The drivers installed and partially tested are: LXDRIV 0 /LATEX LaTeX picture environment NUDRIV 0 /NULL Null device (no output) PSDRIV 1 /PS PostScript printers, monochrome, landscape PSDRIV 2 /VPS Postscript printers, monochrome, portrait PSDRIV 3 /CPS PostScript printers, color, landscape PSDRIV 4 /VCPS PostScript printers, color, portrait TTDRIV 5 /XTERM XTERM Tektronix terminal emulator XWDRIV 1 /XWINDOW Workstations running X Window System XWDRIV 2 /XSERVE Persistent window on X Window System Attempts to port the GIF and X window dump (WD) drivers failed because of lack of one- and two-byte integer types in Fortran under UXPM. Linking ------- Be aware of environment variables (e.g. FORT7EC) controlling the link paths. Backslash in strings -------------------- The Fujitsu Fortran compiler treats the backslash character (\) as an escape character. To access the pgplot font characters requires a "\\" prefix. Porting pgplot5.1.0 to the Fujitsu VPP300 under UXP/V ===================================================== The following are notes on porting pgplot5.1.0 to the Fujitsu VPP300 under UXP/V. The drivers installed and partially tested are: GIDRIV 1 /GIF GIF-format file, landscape GIDRIV 2 /VGIF GIF-format file, portrait LXDRIV 0 /LATEX LaTeX picture environment NUDRIV 0 /NULL Null device (no output) PSDRIV 1 /PS PostScript printers, monochrome, landscape PSDRIV 2 /VPS Postscript printers, monochrome, portrait PSDRIV 3 /CPS PostScript printers, color, landscape PSDRIV 4 /VCPS PostScript printers, color, portrait TTDRIV 5 /XTERM XTERM Tektronix terminal emulator WDDRIV 1 /WD X Window dump file, landscape WDDRIV 2 /VWD X Window dump file, portrait XWDRIV 1 /XWINDOW Workstations running X Window System XWDRIV 2 /XSERVE Persistent window on X Window System Porting the Xmotif driver is probably also possible - I got as far as having multiply defined "MAIN"s in the final link of the example program but didn't follow it up. Code changes ------------ Apart from the appended sys_vpp300/frt_cc.conf, the only change was to dynamic memory use in drivers gidriv.f and wddriv.f. frt does not support %VAL but does support Cray pointers. Changes are of the form INTEGER PIXMAP to POINTER (PIXMAP_PTR) SAVE PIXMAP to SAVE PIXMAP_PTR IER = GRGMEM(BX*BY, PIXMAP) to IER = GRGMEM(BX*BY, PIXMAP_PTR) : CALL GRGI03(1, 1, BX, BY, 0, BX, BY, %VAL(PIXMAP)) to : CALL GRGI03(1, 1, BX, BY, 0, BX, BY, PIXMAP) IER = GRFMEM(BX*BY, PIXMAP) to IER = GRFMEM(BX*BY, PIXMAP_PTR) and similarly for WORK in gidriv.f Linking ------- The Fujitsu Fortran compiler is internally configured for static linking (they provide no means of extracting the link command for application by hand). At present, Fujitsu only provide shared versions of libX11 and libsocket (no static version). The compiler option -Wl,-dy switches to dynamic linking but produces an error message. It appears to be safe to ignore this message. Backslash in strings -------------------- The Fujitsu Fortran compiler treats the backslash character (\) as an escape character. To turn this off, use the -AE option. ----------------------------------------------------------------------- Tim Pearson 7 October 1996 pgplot/sys_fujitsu/uxpm_frt_cc.conf010064400040640000322000000100550656367443400203230ustar00tjpcitmbr00000400000017# Fujitsu UXP/M, frt FORTRAN compiler and /usr/ucb/cc compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="frt" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Ss" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-Ss" # Mandatory. # The C compiler to use. CCOMPL="/usr/ucb/cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -I/usr/ucbinclude" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lsocket -lnsl" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_fujitsu/uxpv_frt_cc.conf010064400040640000322000000100660656367443400203360ustar00tjpcitmbr00000400000017# Fujitsu UXP/V, frt FORTRAN compiler and /usr/ucb/cc compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="frt" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Ss" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-Ss -AE" # Mandatory. # The C compiler to use. CCOMPL="/usr/ccs/ucb/cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-Wl,-dy -L/usr/X11R6/lib -lX11 -lsocket" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_gnuwin32/aaaread.me010064400040640000322000000020610641006076500170100ustar00tjpcitmbr00000400000017pgplot/sys_gnuwin32 The files in this directory are for use with the gnuwin32 and g77. It works under windows 95, but should also work for Windows NT. To date I have only used PSDRIV. There is a problem making libpgplot.a. I suspect a gnuwin32 bug. To work around it edit the makefile generated by makemake Change libpgplot.a : $(PG_ROUTINES) $(PG_NON_STANDARD) $(GR_ROUTINES) \ $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES) ar ru libpgplot.a \ `ls $(PG_ROUTINES) \ $(PG_NON_STANDARD) $(GR_ROUTINES) $(DISPATCH_ROUTINE) \ $(DRIVERS) $(SYSTEM_ROUTINES) | sort | uniq` $(RANLIB) libpgplot.a To libpgplot.a : $(PG_ROUTINES) $(PG_NON_STANDARD) $(GR_ROUTINES) \ $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES) ar ru libpgplot.a $^ $(RANLIB) libpgplot.a Built using gnu-win32 beta 18 http://www.cygnus.com/misc/gnu-win32/ g77 0.5.19.1 http://www.xraylith.wisc.edu/~khan/software/gnu-win32/ David Billinghurst David.Billinghurst@riotinto.com.au 2 Sep 1997 ____________________________________________________________________________ pgplot/sys_gnuwin32/g77_gcc.conf010064400040640000322000000010150641006070600171670ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- XINCL="" MOTIF_INCL="" FCOMPL="g77" FFLAGC="-Wall -O" # backslashes occur only in the demo programs FFLAGD="-fno-backslash" CCOMPL="gcc" CFLAGC="-DPG_PPU -O2" CFLAGD="-O2" PGBIND_FLAGS="bsd" # LIBS="-lX11 \`\$(SRC)/cpg/libgcc_path.sh\` -lgcc -lm -lc -lbsd" LIBS="" RANLIB="ranlib" PGPLOT_LIB="-L\`pwd\` -lpgplot" CPGPLOT_LIB="-L\`pwd\` -lcpgplot -lpgplot" pgplot/sys_irix/f77_cc.conf010064400040640000322000000100270662641364300163340ustar00tjpcitmbr00000400000017# The IRIX f77 FORTRAN compiler and cc C compiler, for IRIX 6.2 #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -O2" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_irix/aaaread.me010064400040640000322000000072450666735741200163340ustar00tjpcitmbr00000400000017These are a few helpful hints for compiling PGPLOT on Silicon Graphics machines running the Irix operating system. IRIX prior to 6.2 ----------------- If you are using an earlier version of IRIX than 6.2, edit the .conf file in this directory and change LIBS="-lX11" to LIBS="-lX11_s" Compilation Options ------------------- The SG Fortran and C compilers have a variety of compilation modes, e.g., -32, -n32, -64. The configuration files provided use the default; if you change this, make sure you compile everything in the same mode. The appropriate options may depend on how your system is set up or how you plan to use the library. For example, one user reported that he needed "-mips4" in Fortran and "-n32" in C. To change the options, eirther edit the makefile, or (better), edit the configuration file in this directory (e.g., pgplot/sys_linux/f77_cc.conf) before running makemake, following the comments in the file. SGI manuals are available online at http://techpubs.sgi.com/library/ PGNUMB ------ A user has reported that PGNUMB does not generate correct code for numbers in exponential format. This affects axes drawn with PGBOX etc. when labels require a multiplying power of 10. This appears to be a due to a bug in the SGI Fortran compiler. It can apparently be fixed by specifying -backslash when compiling the pgplot library. Edit the .conf file and change FFLAGC="-u -O2" to FFLAGC="-u -O2 -backslash" PGPLOT driver for SGI GL library: not recommended ------------------------------------------------- In the drivers/old directory there is a native SGI GL library driver called irdriv.c. Note this driver does not report the position of the cursor correctly unless the window is in the very bottom left of the screen, and may have other problems.. Since the new /XW and /XS devices work fine on the SGI console, you are encouraged to use these instead of /IR. If you want to use this driver, move it to the pgplot/drivers directory, and add the line: IRDRIV 0 /IRIS SiliconGraphics Console SGI only (C) to your local drivers.list file. You will also need to include the gl library when linking programs: add "-lgl" or "-lgl_s" to the definition of LIBS in the .conf file in this directory. Then rerun makemake and make. Some people have gotten a "-lgl_s file not found" message. This error occurs if you only have the runtime version of the gl library installed. The solution is to create a version of pgplot without the IRIS driver. PGPLOT driver for PGDISP/FIGDISP: not supported ----------------------------------------------- The device driver x2driv.c and its supporting server program pgdisp cannot be compiled on SGI. Use xwdriv.c (/XWIN or /XSERV) instead. I no longer support x2driv/pgdisp and I only distribute the code for the benefit of people using the Figaro astronomical image processing system. Other Problems -------------- Some users report warning messages when linking the the demo programs. Messages that routines are multiply defined are probably harmless; if you think they are due to a problem in PGPLOT or the installation procedure, please let me know. Older versions of the compiler would sometimes crash compiling some PGPLOT routines. If this happens, just decrease the level of optimization and try again; e.g., change the flags in the configuration file (*.conf) to -O1 on FFLAGC and -O0 on FFLAGD. PGPLOT should compile and run without the -static flag. This flag is equivalent to including a SAVE statement in the code. If you find a routine that needs the -static then this is a bug in the PGPLOT code that should be fixed. Please report the problem. ________________________________________________________________________ TJP 23-Nov-1998 pgplot/sys_linux/f77_src/grsy00.f010064400040640000322000000064200606064423500173430ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C Hacked version -- uses CHARACTER*2 since G77 does not support INTEGER*2 C B. Toby 11/18/95 C----------------------------------------------------------------------- C INTEGER*2 BUFFER(27000) CHARACTER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END efined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series pgplot/sys_linux/f77_src/grsyxd.f010064400040640000322000000060150606064403400175340ustar00tjpcitmbr00000400000017C*GRSYXD -- obtain the polyline representation of a given symbol C+ SUBROUTINE GRSYXD (SYMBOL, XYGRID, UNUSED) INTEGER SYMBOL INTEGER XYGRID(300) LOGICAL UNUSED C C Return the digitization coordinates of a character. Each character is C defined on a grid with X and Y coordinates in the range (-49,49), C with the origin (0,0) at the center of the character. The coordinate C system is right-handed, with X positive to the right, and Y positive C upward. C C Arguments: C SYMBOL (input) : symbol number in range (1..3000). C XYGRID (output) : height range, width range, and pairs of (x,y) C coordinates returned. Height range = (XYGRID(1), C XYGRID(3)). Width range = (XYGRID(4),XYGRID(5)). C (X,Y) = (XYGRID(K),XYGRID(K+1)) (K=6,8,...). C UNUSED (output) : receives .TRUE. if SYMBOL is an unused symbol C number. A character of normal height and zero width C is returned. Receives .FALSE. if SYMBOL is a C valid symbol number. C C The height range consists of 3 values: (minimum Y, baseline Y, C maximum Y). The first is reached by descenders on lower-case g, p, C q, and y. The second is the bottom of upper-case letters. The third C is the top of upper-case letters. A coordinate pair (-64,0) requests C a pen raise, and a pair (-64,-64) terminates the coordinate list. It C is assumed that movement to the first coordinate position will be C done with the pen raised - no raise command is explicitly included to C do this. C-- C 7-Mar-1983. C 15-Dec-1988 - standardize. C Hacked version -- uses CHARACTER*2 since G77 does not support INTEGER*2 C B. Toby 11/18/95 C----------------------------------------------------------------------- C INTEGER*2 BUFFER(27000) CHARACTER*2 BUFFER(27000) INTEGER INDEX(3000), IX, IY, K, L, LOCBUF INTEGER NC1, NC2 COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER character*2 tmpch(2) integer tmpint equivalence (tmpint,tmpch) C C Extract digitization. C IF (SYMBOL.LT.NC1 .OR. SYMBOL.GT.NC2) GOTO 3000 L = SYMBOL - NC1 + 1 LOCBUF = INDEX(L) IF (LOCBUF .EQ. 0) GOTO 3000 C XYGRID(1) = BUFFER(LOCBUF) tmpint = 0 tmpch(1) = BUFFER(LOCBUF) XYGRID(1) = tmpint LOCBUF = LOCBUF + 1 K = 2 IY = -1 C -- DO WHILE (IY.NE.-64) 100 IF (IY.NE.-64) THEN C IX = BUFFER(LOCBUF)/128 C IY = BUFFER(LOCBUF) - 128*IX - 64 tmpint = 0 tmpch(1) = BUFFER(LOCBUF) IX = tmpint/128 IY = tmpint - 128*IX - 64 XYGRID(K) = IX - 64 XYGRID(K+1) = IY K = K + 2 LOCBUF = LOCBUF + 1 GOTO 100 END IF C -- end DO WHILE UNUSED = .FALSE. RETURN C C Unimplemented character. C 3000 XYGRID(1) = -16 XYGRID(2) = -9 XYGRID(3) = +12 XYGRID(4) = 0 XYGRID(5) = 0 XYGRID(6) = -64 XYGRID(7) = -64 UNUSED = .TRUE. RETURN END pgplot/sys_linux/f77_src/pgpack.f010064400040640000322000000067150606064410400174660ustar00tjpcitmbr00000400000017 PROGRAM PACK C Hacked version -- uses CHARACTER*2 since G77 does not support INTEGER*2 C B. Toby 11/18/95 C----------------------------------------------------------------------- C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000) C INTEGER INDEX(MAXCHR) C INTEGER*2 BUFFER(MAXBUF) CHARACTER*2 BUFFER(MAXBUF) INTEGER I, LENGTH, LOC, NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open stdin. C C Read input file. C 10 CONTINUE C -- read next character READ (*,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (*,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC C BUFFER(LOC) = XYGRID(1) write(BUFFER(LOC),'(a2)') XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 C BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 write(BUFFER(LOC),'(a2)') $ 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE C C Write output file. C OPEN (UNIT=2, STATUS='NEW', FORM='UNFORMATTED', FILE='grfont.dat') NC1 = 1 NC2 = 3000 WRITE (2) NC1,NC2,LOC,INDEX,BUFFER CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/sys_linux/f77_src/iand.c010064400040640000322000000002200541335364400171210ustar00tjpcitmbr00000400000017int iand_ (a,b) int *a; int *b; { static int res; res = (*a & *b); /* printf ("iand result: %d\n",res); */ return (res); } pgplot/sys_linux/g77_gcc.conf010064400040640000322000000102150674017243100166610ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler on an elf-system. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="$XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/include $XINCL" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -Wall -fPIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-Wall -fPIC -DPG_PPU -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-Wall -O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6/lib -lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="gcc -shared -o $SHARED_LIB" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_linux/f95_src/grgenv.f010064400040640000322000000025400650624737300175150ustar00tjpcitmbr00000400000017C*GRGENV -- get value of PGPLOT environment parameter (NAGWare f95) C+ SUBROUTINE GRGENV(NAME, VALUE, L) USE F90_UNIX_ENV, ONLY : GETENV CHARACTER*(*) NAME, VALUE INTEGER L C C Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, C environment parameters are UNIX environment variables; e.g. parameter C ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not C recursive and is case-sensitive. C C Arguments: C NAME : (input) the name of the parameter to evaluate. C VALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C L : receives the number of characters in VALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 25-Mar-1988 C----------------------------------------------------------------------- INTEGER I, LIN, ERRNO CHARACTER*32 TEST C TEST = 'PGPLOT_'//NAME LIN = INDEX(TEST, ' ')-1 ERRNO = 0 CALL GETENV(TEST(:LIN), VALUE, ERRNO=ERRNO) IF (ERRNO.NE.0 .OR. VALUE.EQ.' ') THEN L = 0 ELSE DO 10 I=LEN(VALUE),1,-1 L = I IF (VALUE(I:I).NE.' ') GOTO 20 10 CONTINUE L = 0 20 CONTINUE END IF END pgplot/sys_linux/f95_src/grgcom.f010064400040640000322000000016450650624732400175040ustar00tjpcitmbr00000400000017C*GRGCOM -- read with prompt from user's terminal (NAGWare f95) C+ INTEGER FUNCTION GRGCOM(STRING, PROMPT, L) CHARACTER*(*) STRING, PROMPT INTEGER L C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C STRING : (output) receives the string read from the terminal. C PROMPT : (input) prompt string. C L : (output) length of STRING. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 25-Mar-1998 C----------------------------------------------------------------------- INTEGER IER C GRGCOM = 0 L = 0 IER = 0 WRITE (*, '(1X,A)', ADVANCE="NO", IOSTAT=IER) PROMPT IF (IER.EQ.0) READ (*, '(A)', IOSTAT=IER) STRING IF (IER.EQ.0) GRGCOM = 1 L = LEN(STRING) 10 IF (STRING(L:L).NE.' ') GOTO 20 L = L-1 GOTO 10 20 CONTINUE END pgplot/sys_linux/aaaread.me010064400040640000322000000112430672236477500165130ustar00tjpcitmbr00000400000017pgplot/sys_linux The files in this directory are for use with the Linux operating system. Note that Linux systems come in two varieties: one that uses the a.out for binaries (now mostly obsolete), and another uses the elf format. You may need to modify the .conf file you choose to use; e.g., on some varieties of Linux, the X11 libraries are in directory /usr/X11/lib while on others they are in /usr/X11R6/lib. If necessary, make a private configuration file called local.conf in the installation directory (see the installation instructions). (1) Files f77_gcc.conf and fort77-gcc.conf are for use with the 'f77' command that uses the f2c Fortran translator and the gcc C compiler, on 'elf' systems. Choose "f77_gcc" if the command you use to compile a Fortran program with f2c is "f77", or "fort77_gcc" if the comand is "fort77". Note that the f2c compiler used by Linux interprets the character "\" in Fortran literal character strings as a Unix escape character. To compile the demo programs (or other programs that use "\" as a PGPLOT escape character) correctly, you need to turn this off. There appears to be no way to do this on the f77 command line, but options for the f2c program can be specified in an environment variable: e.g., type [csh] setenv F2CFLAGS "-\!bs" [sh] set F2CFLAGS "-\!bs" ; export F2CFLAGS [bash] declare -x F2CFLAGS='-!bs' before starting the makefile (the backslash is to quote the exclamation mark; it is not part of the F2CFLAGS value). Note that several of the PGPLOT device drivers use Fortran extensions (most notably the %VAL() syntax for passing an argument by value) that are not supported by f2c. These drivers cannot be used with Linux. The drivers include: epdriv.f, gidriv.f, ppdriv.f, wddriv.f. Driver ljdriv.f also cannot be compiled with this system. Some Linux users report that make dies with "error 4". This is apparently due to an error in the f77 script. Workarounds include using "make -k" to continue after the error; upgrading the bash shell; using a tcsh shell; using g77 instead of f77. On some versions of Linux and/or f2c, creation of the "pgxwin_server" and "pgdisp" programs fails with the message: /usr/lib/libf2c.so.0.11: undefined reference to `MAIN__' You should be able to create the program by re-executing the gcc comand that failed, omitting the "-lf2c" option. [I am looking into ways of modifying the installation procedure to avoid this problem.] The f2c Fortran support library does a setbuf(stderr) to make stderr buffered. This may affect programs that call PGPLOT from C. To make stderr output appear when you want, use fflush(stderr) where appropriate. (This is reportedly fixed in recent versions of f2c). (2) File g77_gcc.conf uses the beta gnu g77 compiler, on 'elf' systems. (3) File g77_elf_aout.conf uses the beta gnu g77 compiler, on 'a.out' systems. Older versions of g77 do not support INTEGER*2 or BYTE variables and thus many drivers will not compile in g77. Version 0.5.18 is reported to handle BYTE and %VAL() and compile PGPLOT correctly. Although g77 compiles more drivers than f2c, there are several that it fails to compile (e.g., mfdriv.f, pxdriv.f). If you have a real need for any of these drivers, let me know and I will see if I can fix the problem. (4) File f95_gcc.conf uses the NAGWare f95 (Fortran-95) compiler; system-specific versions of some subroutines are in subdirectory f95_src. (5) File pgf77.conf uses the Portland Group pgf77 FORTRAN compiler and pgcc C compiler. The following problem has been reported with this system: "Routine PGSAVE does not work when PGPLOT is used as a shared library. When linked statically, everything worked fine. This seemed not to depend on any of the compiler flags I considered be reasonable to change, e.g., optimization. It also happened for both compilers, pgf77 and pgf90. The code crashed immediately when the pgsave subroutine was called, before execution of the first statement." I believe this to be due to a compiler bug. Tim Pearson 24-Mar-1998 (with thanks to Michael Eisinger, Massimo Manghi, Peter Teuben, Brian Toby, JaiYong Lee, Klaus-Georg Adams, Alexander Heger, and others) ____________________________________________________________________________ Additional Notes 27-Feb-1999 (from a user) There seems to be a compatibility problem with libc-2.1 and libc-2.0. Apparently the problem is between libc-2.1/egcs-1.1.1 and libc-2.0.6/egcs-1.1.1. The necessary procedure is to compile and install egcs-1.1.1 then compile and install libc-2.1. Then recompile egcs-1.1.1 under libc-2.1 and reinstall. Then you can reconfigure pgplot and recompile. After this circuitous process pgplot executables work. I tried this procedure on two different machines and it worked on both. pgplot/sys_linux/f77_gcc.conf010064400040640000322000000101730724334423500166650ustar00tjpcitmbr00000400000017# The f77 [f2c] Fortran-to_C converter and Gnu gcc C compiler. # Revised 30 Oct 1996 #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="$XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lf2c -L/usr/X11R6/lib -lX11 \`\$(SRC)/cpg/libgcc_path.sh\` -lgcc -lm -lc" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/f77_src" pgplot/sys_linux/absoft_gcc.conf010064400040640000322000000102450724334423500175400ustar00tjpcitmbr00000400000017# The Absoft f77 FORTRAN compiler and Gnu gcc C compiler. # # Do not use the f77 -K option. You may need option f77 -N9. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="$XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6/lib -lX11 \`\$(SRC)/cpg/libgcc_path.sh\` -lgcc -lm -lc" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/af77_src" pgplot/sys_linux/af77_src/grdate.c010064400040640000322000000033600567152653700176360ustar00tjpcitmbr00000400000017#include #include /**GRDATE -- get date and time as character string (Cray) *+ * SUBROUTINE GRDATE(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. * To receive the whole string, the STRING should be declared * CHARACTER*17. * * Arguments: * STRING : receives date and time, truncated or extended with * blanks as necessary. * SLEN : receives the number of characters in STRING, excluding * trailing blanks. This will always be 17, unless the length * of the string supplied is shorter. *-- * 13-Nov-1994 - [mcs] Abosft FORTRAN callable C version for NeXT. *----------------------------------------------------------------------- */ void GRDATE(string, slen, maxlen, w_slen) char *string; int *slen; int maxlen, w_slen; { char vtime[18]; /* Output string compilation buffer */ char *utime; /* Returned string from ctime() */ time_t x; /* Time returned by time() */ int i; /* * Get the standard C time string. */ time(&x); utime = ctime(&x); /* * Copy a re-organised version of the time string into vtime[]. */ vtime[0] = utime[8]; vtime[1] = utime[9]; vtime[2] = '-'; vtime[3] = utime[4]; vtime[4] = utime[5]; vtime[5] = utime[6]; vtime[6] = '-'; vtime[7] = utime[20]; vtime[8] = utime[21]; vtime[9] = utime[22]; vtime[10] = utime[23]; vtime[11] = ' '; strncpy(vtime+12, utime+11, 5); vtime[17]='\0'; /* * Copy up to maxlen characters of vtime into the output FORTRAN string. */ strncpy(string, vtime, maxlen); *slen = (maxlen < 17) ? maxlen : 17; /* * Pad the FORTRAN string with spaces. */ for(i=17; i #include #include #include /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNAME) * INTEGER GROFIL * CHARACTER*(*) FNAME * * Opens file FNAME for writing. * GROFIL returns the file descriptor for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, STRING) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occurred while opening the file. *- */ int GROFIL(fname, fname_len) char *fname; int fname_len; { char *name = fname; /* C pointer to FORTRAN string */ int slen = fname_len; /* Length of the FORTRAN string */ char *buff=0; /* Dynamically allocated copy of name[] */ int fd = -1; /* File descriptor to be returned */ /* * Determine how long the FORTRAN string is by searching for the last * non-blank character in the string. */ while(slen>0 && name[slen-1]==' ') slen--; /* * Dynamically allocate a buffer to copy the FORTRAN string into. */ buff = (char *) malloc((slen+1) * sizeof(char)); if(buff) { /* * Make a C string copy of the FORTRAN string. */ strncpy(buff, name, slen); buff[slen] = '\0'; /* * Open the file and return its descriptor. */ fd = open(buff, O_WRONLY | O_CREAT | O_TRUNC, 0666); free(buff); } else { fprintf(stderr, "gropfil: Insufficient memory\n"); }; return fd; } /* **&GRCFIL -- Close file from GRFILEIO access *+ * FUNCTION GRCFIL (FD) * INTEGER GRCFIL (FD) * * Closes the file with descriptor FD from GRFILEIO access. GRCFIL returns * 0 when properly closed. Otherwise, use PERRORF to report the error. * * Usage: * IOS = GRCFIL (FD) * or: * CALL GRCFIL (FD) * * In the last case the return code is ignored. * * Arguments: * FD (input) : File descriptor returned by GROFIL. * GRCFIL (output) : Error code or 0 on proper closing. *- */ int GRCFIL(fd, w_fd) int *fd; int w_fd; /* Width of fd argument (appended by Absoft FORTRAN) */ { return close(*fd); } /* **&GRWFIL -- GRFILEIO write routine *+ * FUNCTION GRWFIL (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFIL * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFIL. If * GRWFIL < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFIL (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFIL(fd, nbytes, buf, w_fd, w_nbytes, w_buf) int *fd, *nbytes; char *buf; int w_fd, w_nbytes, w_buf; /* Width of arguments */ { return write(*fd, (void *) buf, *nbytes); } /* **&GRWFCH -- GRFILEIO write FORTRAN character sub-STRING routine *+ * FUNCTION GRWFCH (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFCH * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFCH. If * GRWFCH < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFCH (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFCH(fd, nbytes, buf, w_fd, w_nbytes, w_buf) int *fd, *nbytes; char *buf; int w_fd, w_nbytes, w_buf; /* Width of arguments */ { return write(*fd, (void *) buf, *nbytes); } pgplot/sys_linux/af77_src/grgenv.c010064400040640000322000000050750567207202200176470ustar00tjpcitmbr00000400000017#include #include /* **GRGENV -- get value of PGPLOT environment parameter (Next) *+ * SUBROUTINE GRGENV(NAME, VALUE, L) * CHARACTER*(*) NAME, VALUE * INTEGER L * * Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, * environment parameters are UNIX environment variables; e.g. parameter * ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not * recursive and is case-sensitive. * * Arguments: * NAME : (input) the name of the parameter to evaluate. * VALUE : receives the value of the parameter, truncated or extended * with blanks as necessary. If the parameter is undefined, * a blank string is returned. * L : receives the number of characters in VALUE, excluding * trailing blanks. If the parameter is undefined, zero is * returned. *-- * 13-Nov-1994 - [mcs] Absoft FORTRAN callable C version for NeXT. *----------------------------------------------------------------------- */ void GRGENV(name, value, length, name_dim, value_dim, length_dim) char *name, *value; int *length; int name_dim, value_dim, length_dim; { static char *prefix = "PGPLOT_"; /* Environment variable name prefix */ char test[33]; /* PGPLOT_* Concatenation buffer */ int name_len; /* Un-padded length of 'name' string */ int prefix_len; /* The length of prefix[] */ char *env=0; /* Environment variable value */ int i; /* * Determine the length of 'name' by searching for the last * non-space character. */ name_len = name_dim; while(name_len > 0 && name[name_len-1] == ' ') name_len--; /* * Determine the length of the prefix. */ prefix_len = strlen(prefix); /* * Prefix 'name' with PGPLOT_ if there is room in test[]. */ if(prefix_len + name_len + 1 <= sizeof(test)/sizeof(char)) { strcpy(test, prefix); strncpy(&test[prefix_len], name, name_len); test[prefix_len+name_len] = '\0'; /* * Get the value of the environment variable now named in test[]. */ env = getenv(test); }; /* * Substitute an empty string if no value was obtained, or the value * obtained is too long to fit in the output string. */ if(env==0 || strlen(env) > value_dim) env = ""; /* * Copy the environment variable value into the output string. */ strncpy(value, env, value_dim); /* * Return the unpadded length of the string. */ { int env_len = strlen(env); *length = (env_len <= value_dim) ? env_len : value_dim; }; /* * Pad the fortran string with spaces. */ for(i = *length; i */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) GRGETC(val, w_val) int *val; int w_val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } ng escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 pgplot/sys_linux/af77_src/grtermio.c010064400040640000322000000056510631554555200202170ustar00tjpcitmbr00000400000017/* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRRTER. Abosft FORTRAN callable version for Linux */ #include #include #include int GROTER(cdev, ldev, w_cdev, w_ldev) char *cdev; long int *ldev; int w_cdev, w_ldev; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } int GRCTER(fd, w_fd) int *fd; int w_fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } void GRWTER(fd, cbuf, lbuf, w_fd, w_cbuf, w_lbuf) int *fd; char *cbuf; long int *lbuf; int w_fd, w_cbuf, w_lbuf; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } GRPTER(fd, cprom, lprom, cbuf, lbuf, w_fd, w_cprom, w_lprom, w_cbuf, w_lbuf) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int w_fd, w_cprom, w_lprom, w_cbuf, w_lbuf; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_linux/af77_src/gruser.c010064400040640000322000000022050567152653700176740ustar00tjpcitmbr00000400000017/* **GRUSER -- get user name. *+ * SUBROUTINE GRUSER(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the name of the user running the program. * * Arguments: * STRING : receives user name, truncated or extended with * blanks as necessary. * L : receives the number of characters in VALUE, excluding * trailing blanks. *-- * 13-Nov-1994 [mcs] Absoft FORTRAN callable version for NeXT. *----------------------------------------------------------------------- */ char *getlogin(); void GRUSER(string, length, maxlen, w_length) char *string; int *length; int maxlen; int w_length; { int i; /* * Get the login name of the PGPLOT user. */ char *user = getlogin(); /* * If the user name is not available substitute an empty string. */ if(!user) user = ""; /* * Copy the user name to the output string. */ for(i=0; i pgplot.makeout Echo "# `Date -t` ----- Executing build commands." pgplot.makeout #Delete "pgplot.makeout Echo "# `Date -t` ----- Done." pgplot/sys_mac/create_doc.f010064400040640000322000000224420601414007500164300ustar00tjpcitmbr00000400000017 Program create_doc Implicit None Integer I,J,K,numsub,Unitnm(0:200),Sizehd(0:200),End(0:200),start,loc,M, + locarr(50),starto,headar(50),ndum,match Character Line*100,header(100)*200,Asizeh(0:200)*3,lineout*200 C Declarations needed to get arguments from MPW command line. C Argument 0 is always create_doc and is ignored. Arguments 2 and up are the C actual files that will be searched to build the documentation. Argument C 1 is the directory containing the files. include 'Types.f' STRUCTURE /Args/ record /StringPtr/ arg(0:7) END STRUCTURE integer*4 ArgC pointer /Args/ ArgV integer*4 JARGC ! ArgC = JArgC() EXTERNAL JARGC ! # of arguments+1 integer*4 JARGV ! ArgV = JArgV() EXTERNAL JARGV ! pointer to an array of string pointers record /StringPtr/ P integer*4 p Data UnitNm/201*0/ Open(Unit=1,File='pgplot.doc',Status='Unknown',Err=2000, + carriagecontrol='Fortran') Open(Unit=2,File='pgplot.html',Status='Unknown',Err=3000, + carriagecontrol='Fortran') c 1 2 3 4 5 6 7 c2345678901234567890123456789012345678901234567890123456789012345678901234567890 Write(1,'(''PGPLOT GRAPHICS SUBROUTINE LIBRARY Version 5.0'',//, +''PGPLOT is a Fortran subroutine package for drawing graphs on a variety'',/, +"of display devices. For more details, see the manual ``PGPLOT Graphics",/, +"Subroutine Library'''' available from T. J. Pearson",/, +''(tjp@astro.caltech.edu).'',//, +''INDEX OF ROUTINES'',/)') Write(2,'("",/, +"PGPLOT Subroutine Descriptions",/, +"",//, +"

PGPLOT Subroutine Descriptions

",//, +"

Introduction

",//, +"This appendix includes a list of all the PGPLOT subroutines,",/, +"and then gives detailed instructions for the use of each routine in",/, +"Fortran programs. The subroutine descriptions are in alphabetical order.",//, +"

Arguments

",//, +"The subroutine descriptions indicate the data type of each",/, +"argument. When arguments are described as ``input'''', they may be",/, +"replaced with constants or expressions in the CALL",/, +"statement, but make sure that the constant or expression has the",/, +"correct data type.",//, +"
INTEGER arguments:",/, +"
these should be declared",/, +"INTEGER or INTEGER*4 in the calling program,",/, +"not INTEGER*2.",/)') Write(2,'("
REAL arguments:",/, +"
these should be declared",/, +"REAL or REAL*4 in the calling program, not",/, +"REAL*8 or DOUBLE PRECISION.",//, +"
LOGICAL arguments:",/, +"
these should be declared",/, +"LOGICAL or LOGICAL*4 in the calling program.",//, +"
CHARACTER arguments:",/, +"
any valid Fortran",/, +"CHARACTER variable may be used (declared",/, +"CHARACTER*n for some integer n).",//, +"
",//, +"

Index of Routines

",//, +"Version 5.0

",///, +"

    ")') C Get the number of arguments and actual arguments ArgC = JARGC() ArgV = JARGV() C Test each file to see if it is used in pgplot.doc. Files which C will be used to create the documentation have 'C*PG'. Store the argument C number in Unitnm(numsub) and increment numsub. This first do loop creates the C index. numsub = 0 do i=2,ArgC-1 Open(10,file=ArgV^.arg(1).P^//ArgV^.arg(i).P^,Status='OLD') 5 Read(10,'(A100)',End=10) line If (line(1:4) .eq. 'C*PG') Then numsub = numsub + 1 Unitnm(numsub) = i C Trim is a Language Systems function which removes the trailing spaces from C the argument and returns a String*255 data type. sizehd(numsub) = len(trim(line(3:))) header(numsub)(1:sizehd(numsub)) = line(3:sizehd(numsub)+2) Write(Asizeh(numsub),'(I3)') sizehd(numsub) Write(1,'(T1,A'//Asizeh(numsub)//')') + header(numsub)(1:sizehd(numsub)) C The variable End(numsub) stores the location for the end of the subroutine C name, while sizehd(numsub) stores the length of the header line. End(numsub) = index(header(numsub),' ') - 1 line = '
  • '//header(numsub)(1:end(numsub))//''// + header(numsub)(end(numsub)+1:sizehd(numsub)) Sizehd(0) = len(Trim(line)) Write(Asizeh(0),'(I3)') sizehd(0) Write(2,'(T1,A'//Asizeh(0)//')')line(1:sizehd(0)) End If Go to 5 10 Continue Close(10) enddo Write(2,'(T1,''
'')') C This second do loop creates the actual documentation. First write the C header, then look for C+ and copy all the lines between C+ and C- to C pgplot.doc and pgplot.html. Do 30 J = 1,numsub Write(1,'(//,''----------------------------------------------'', + ''--------------------------'')') Write(1,'(T1,A8,A'//Asizeh(j)//')') + 'Module: ',header(J)(1:sizehd(j)) Write(1,'(''----------------------------------------------'', + ''--------------------------'',/)') line = '

'//header(J)(1:end(J))//''// + header(J)(end(J)+1:sizehd(J))//'

' Write(2,'(/,T1,''
'')') sizehd(0) = len(trim(line)) Write(asizeh(0),'(I3)') sizehd(0) Write(2,'(T1,A'//Asizeh(0)//')')line(1:sizehd(0)) Write(2,'(T1,''
'')')
	     if (Unitnm(J-1) .ne. Unitnm(J)) then
            Open(10,file=ArgV^.arg(1).P^//ArgV^.arg(Unitnm(J)).P^,
     +      Status='OLD')
         End If		   
20       Continue
            Read(10,'(A100)',End=30) line
		 If (line(1:2) .ne. 'C+') Go to 20
25       Read(10,'(A100)',End=30) line
            If (line(1:3) .ne. 'C--') Then
			   sizehd(0) = len(trim(line))
	           If (line(1:1) .eq. ' ') Then
	   		      Write(Asizeh(0),'(I3)') sizehd(0) 
			      Write(1,'(T1,A'//Asizeh(0)//')') line(1:sizehd(0))
			      Write(2,'(T1,A'//Asizeh(0)//')') line(1:sizehd(0))
	              Go to 25
			   Else
			      Write(Asizeh(0),'(I3)') max(0,sizehd(0)-2)
			      Write(1,'(T1,A'//Asizeh(0)//')') line(3:sizehd(0))
			   End If
	           lineout = ''
			   starto = 1
			   I = 3
50             Continue
			      If (line(I:I) .eq. '<') Then
				     lineout(starto:starto+3) = '<'
					 I = I + 1
					 starto = starto + 4
				  Else if (line(I:I) .eq. '>') then
				  	 lineout(starto:starto+3) = '>'
					 I = I + 1
					 starto = starto + 4
				  Else if (line(I:I) .eq. '&') Then
				     lineout(starto:starto+4) = '&'
					 I = I + 1
					 starto = starto + 5
				  Else If (line(I:I) .eq. 'P')  Then
				     If ((I .lt. sizehd(0)) .and. (line(I+1:I+1) .eq. 'G')) Then
					    match = 0
					    Do 55 K = 1, numsub
						   If (((sizehd(0) - I+1) .ge. end(K))
     +                       .and. (line(I+2:I-1+end(K)) .eq. header(K)(3:end(K))))Then
	                         match = Match + 1
							 headar(match) = K
						   End If
55                      Continue
                        If (match .ge. 1) Then
						   ndum = headar(1)
						   If (match .gt. 1) Then
							  Do 56 K = 1, Match - 1 
							     If (end(headar(K+1)) .gt. end(ndum)) Then
								    ndum = headar(K+1)
								 End If
56                            Continue
                           End If
						   lineout(starto:starto+15+2*end(ndum)) = ''//
     +                         header(ndum)(1:end(ndum))//''
	                       starto = starto + 16 + 2*end(ndum)
						   I = I + end(ndum)
	                    Else 
				           lineout(starto:starto) = line(I:I)
						   I = I + 1
					       starto = starto + 1
						End If
					 Else
				        lineout(starto:starto) = line(I:I)
						I = I + 1
					    starto = starto + 1
					 End If
				  Else
				     lineout(starto:starto) = line(I:I)
					 I = I + 1
					 starto = starto + 1
				  End If
               If (I .le. sizehd(0)) Go to 50
C  Write out line to pgplot.html.
			   sizehd(0) = len(trim(lineout))
			   Write(Asizeh(0),'(I3)') sizehd(0)
			   Write(2,'(T1,A'//Asizeh(0)//')')lineout(1:sizehd(0))
			   Go to 25
			Else
		       Write(2,'(T1,''
'')') End If 30 Continue Write(2,'(T1,''
'',/,'''')') close(2) Close(1) Call F_endMPW(0) 2000 Continue Write(*,*) ' Error: Could not open pgplot.doc.' Call F_EndMPW(1) 3000 Continue Write(*,*) ' Error: Could not open pgplot.html.' Call F_EndMPW(1) End Subroutine Sortar(Int1,Int2,N) Implicit None Integer Int1(*),Int2(*),N,I,ndum Logical sorted 5 sorted = .True. I = 1 10 If (I .lt. N) Then If (Int1(I+1) .lt. Int1(I)) Then sorted = .False. ndum = int1(I) int1(I) = Int1(I+1) int1(I+1) = ndum ndum = int2(I) int2(I) = Int2(I+1) int2(I+1) = ndum End If I = I + 1 Go to 10 End If If (.not. sorted) Go to 5 Return End pgplot/sys_mac/create_grexec.f010064400040640000322000000071270600517124500171460ustar00tjpcitmbr00000400000017c 1 2 3 4 5 6 7 c2345678901234567890123456789012345678901234567890123456789012345678901234567890 Program crgrexc Implicit None Integer I,Ndev,options(99),start Character Line*80,driver(99)*6 Open(Unit=10,File='drivers.list',Status='OLD',Err=1000) Open(Unit=11,File='grexec.f',Status='Unknown',Err=3000) Ndev = 0 10 Read(10,'(A80)',End=2000)Line If (Line(1:1) .eq. '!') go to 10 Ndev = Ndev + 1 Driver(Ndev) = line(3:8) Read(line(10:10),'(I1)') options(Ndev) Go to 10 Continue 2000 If (Ndev .eq. 0) Then Write(*,'('' Error: No drivers were selected. Select drivers '')') Write(*,'('' by removing ! at beginning of line.'')') Call F_EndMPW(1) Else If (Ndev .le. 99) Then Write(11,'(''C*GREXEC -- PGPLOT device handler dispatch routine'')') Write(11,'(''C+'')') Write(11,'( + '' SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR)'')') Write(11,'('' INTEGER IDEV, IFUNC, NBUF, LCHR'')') Write(11,'('' REAL RBUF(*)'')') Write(11,'('' CHARACTER*(*) CHR'')') Write(11,'(''C---'')') Write(11,'('' INTEGER NDEV'')') Write(11,'('' PARAMETER (NDEV='',I3,'')'') ') Ndev Write(11,'('' CHARACTER*10 MSG'')') Write(11,'(''C---'')') Line(1:14)='('' GOTO(' I = 0 Start = 11 20 I = I + 1 If (I .lt. Ndev) Then If (Start .lt. 60) Then Start = Start + 3 Else line(start+3:start+5) = ''')' Write(11,line(1:Start+5)) Line(1:14)='('' + ' Start = 14 End If Write(Line(start:start+2),'(i2,'','')') I Go to 20 Else Start = Start + 3 Write(Line(start:start+7),'(i2,'') Idev'')') I Line(start+8:start+11) = ''')' Write(11,line(1:start+11)) End if c 1 2 3 4 5 6 7 c2345678901234567890123456789012345678901234567890123456789012345678901234567890 Else Write(*,*) 'Error: Ndev > 99. Increase Ndev and check program.' Call F_EndMPW(1) End If Write(11,'('' IF (IDEV.EQ.0) THEN'')') Write(11,'('' RBUF(1) = NDEV'')') Write(11,'('' NBUF = 1'')') Write(11,'('' ELSE'')') Write(11,*)' WRITE (MSG,''(I10)'') IDEV' Write(11,*)' CALL GRWARN(''Unknown device', + ' code in GREXEC: ''//MSG)' Write(11,'('' END IF'')') Write(11,'('' RETURN'')') Write(11,'(''C---'')') Do 30 I = 1, Ndev If (Options(i) .eq. 0) Then Write(11,'(I2,'' CALL '',A6, + ''(IFUNC,RBUF,NBUF,CHR,LCHR)'')')I,Driver(I) Else Write(11,'(I2,'' CALL '',A6, + ''(IFUNC,RBUF,NBUF,CHR,LCHR,'',I2,'')'')') + I,Driver(I),Options(i) End If Write(11,'('' RETURN'')') 30 Continue Write(11,'(''C'')') Write(11,'('' END'')') Write(*,*) 'Finished creating grexec.f' Call F_EndMPW(0) 1000 Continue Write(*,*)' Error: Could not open drivers.list in current directory.' Write(*,*)' Copy drivers.list from drivers directory to here.' Call F_EndMPW(1) 3000 Continue Write(*,*) ' Error: Could not open grexec.f.' Call F_EndMPW(1) Endpgplot/sys_mac/drivers.list010064400040640000322000000126010602406371500165460ustar00tjpcitmbr00000400000017! PGPLOT drivers. !------------------------------------------------------------------------------ ! To configure PGPLOT, ensure that drivers you do not want are ! commented out (place ! in column 1). N.B. Many device-drivers are ! available on selected operating systems only. !------------------------------------------------------------------------------ ! File Code Description Restrictions ! ARDRIV 0 /ARGS Sigma Args image device, 7000 series VMS ! BCDRIV 0 /BCANON Canon Laser printer (bitmap version), landscape ! CADRIV 0 /CANON Canon Laser printer, LBP-8/A2, landscape ! CCDRIV 0 /CCP DEC LJ250 Color Companion printer ! CWDRIV 0 /CW6320 Gould/Bryans Colourwriter 6320 pen plotter Std F77 ! EPDRIV 0 /EPSON Epson FX100 dot matrix printer ! EXDRIV 1 /EXCL Talaris/EXCL printers, landscape ! EXDRIV 2 /EXCL Talaris/EXCL printers, portrait ! GCDRIV 0 /GENICOM Genicom 4410 dot-matrix printer, landscape ! Caution: use of GIDRIV may require a license from Unisys: ! GIDRIV 1 /GIF GIF-format file, landscape ! GIDRIV 2 /VGIF GIF-format file, portrait GLDRIV 1 /HPGL Hewlett-Packard HP-GL plotters, landscape Std F77 GLDRIV 2 /VHPGL Hewlett-Packard HP-GL plotters, portrait Std F77 ! GODRIV 0 /GOC GOC Sigma T5670 terminal VMS ! GRDRIV 0 /GRINNELL Grinnell GMR-270 Image Display VMS ! GVDRIV 0 /GVENICOM Genicom 4410 dot-matrix printer, portrait HGDRIV 0 /HPGL2 HP-GL/2 device, only tested with a Laserjet III printer ! HIDRIV 0 /HIDMP Houston Instruments HIDMP pen plotter ! HJDRIV 0 /HJ Hewlett-Packard Desk/Laserjet printer HPDRIV 0 /HP7221 Hewlett-Packard HP7221 pen plotter Std F77 ! IKDRIV 0 /IKON Digisolve Ikon Pixel Engine VMS ! IMDRIV 0 /IMPRESS Imagen printers (Impress language), landscape ! IRDRIV 0 /IRIS SiliconGraphics Console SGI (C) ! LADRIV 0 /LA50 Dec LA50 and other sixel printers ! LIDRIV 0 /LIACOM Liacom Graphic Video Display (GVD-02) VMS ! LJDRIV 0 /LJ Hewlett-Packard LaserJet printers ! LSDRIV 1 /LIPS2 Canon LaserShot printer (landscape) ! LSDRIV 2 /VLIPS2 Canon LaserShot printer (portrait) ! LNDRIV 0 /LN03 Dec LN03-PLUS Laser printer (landscape) ! LVDRIV 0 /LVN03 Dec LN03-PLUS Laser printer (portrait) LXDRIV 0 /LATEX LaTeX picture environment MCDRIV 0 /MAC Macintosh window MFDRIV 0 /FILE PGPLOT graphics metafile ! NEDRIV 0 /NEXT Computers running NeXTstep operating system NUDRIV 0 /NULL Null device (no output) Std F77 ! PKDRIV 0 /PK Peritek Corp. VCK-Q frame-buffer video VMS ! PPDRIV 1 /PPM Portable Pixel Map file, landscape ! PPDRIV 2 /VPPM Portable PIxel Map file, portrait PSDRIV 1 /PS PostScript printers, monochrome, landscape Std F77 PSDRIV 2 /VPS Postscript printers, monochrome, portrait Std F77 PSDRIV 3 /CPS PostScript printers, color, landscape Std F77 PSDRIV 4 /VCPS PostScript printers, color, portrait Std F77 ! PXDRIV 0 /PRINTRONI Printronix P300 or P600 dot-matrix printer ! PZDRIV 0 /PERITEK Peritek Corp. VCH-Q frame-buffer video VMS ! QMDRIV 1 /QMS QUIC devices (QMS and Talaris), landscape Std F77 ! QMDRIV 2 /VQMS QUIC devices (QMS and Talaris), portrait Std F77 ! SVDRIV 0 /SUNVIEW Sun workstations running SunView SunOS C ! TFDRIV 0 /TFILE Tektronix-format disk file VMS ! TODRIV 0 /TOSHIBA Toshiba "3-in-one" printer, model P351 ! TTDRIV 1 /TEK4010 Tektronix 4006/4010 storage-tube terminal Std F77 ! TTDRIV 2 /GF GraphOn terminal Std F77 ! TTDRIV 3 /RETRO RetroGraphics terminal Std F77 ! TTDRIV 4 /GTERM GTERM Tektronix terminal emulator Std F77 ! TTDRIV 5 /XTERM XTERM Tektronix terminal emulator Std F77 ! TTDRIV 6 /ZSTEM ZSTEM terminal emulator Std F77 ! TTDRIV 7 /V603 Visual 603 terminal Std F77 ! TTDRIV 8 /KRM3 Kermit 3 on IBM-PC Std F77 ! TTDRIV 9 /TK4100 Tektronix 4100-series terminals Std F77 ! TXDRIV 0 /TX TeX PK Font Output files ! VADRIV 0 /VCANON Canon Laser printer, LBP-8/A2, portrait ! VBDRIV 0 /VBCANON Canon Laser printer (bitmap version), portrait ! VEDRIV 1 /VERSATEC Versatec V80 dot-matrix printer, landscape ! VEDRIV 2 /VVERSATEC Versatec V80 dot-matrix printer, portrait ! VIDRIV 0 /VIPRESS Imagen printers (Impress language), portrait ! VTDRIV 0 /VT125 Dec Regis terminals (VT125 etc.) Std F77 ! WDDRIV 1 /WD X Window dump file, landscape ! WDDRIV 2 /VWD X Window dump file, portrait ! WSDRIV 0 /WS VAX workstations running VWS software VMS ! X2DRIV 0 /XDISP PGDISP or FIGDISP server for X workstations C ! XWDRIV 1 /XWINDOW Workstations running X Window System C ! XWDRIV 2 /XSERVE Persistent window on X Window System C ! ZEDRIV 0 /ZETA Zeta 8 Digital Plotter ! ! The following drivers can only be used in PGPLOT installations on MS-DOS ! systems with appropriate hardware and software. Do not select these ! on UNIX or VMS systems. ! ! LHDRIV 0 /LH IBM PCs and clones, Lahey F77 32-bit Fortran v5.0 ! MSDRIV 0 /MSOFT IBM PCs and clones running Microsoft Fortran 5.0 ! SSDRIV 0 /SS IBM PCs and clones, MS-DOS, Salford Software FTN ! ! The following driver can only be used in PGPLOT installations on Acorn ! Archimedes systems with appropriate hardware and software. ! ! ACDRIV 0 /ARC Acorn Archimedes computer pgplot/sys_mac/grdate.f010064400040640000322000000025600602666043400156160ustar00tjpcitmbr00000400000017 C*GRDATE -- get date and time as character string (Mac) C+ SUBROUTINE GRDATE(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the STRING should be declared C CHARACTER*17. C C Arguments: C STRING : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 19-Jan-1988 C 21-Jan-1995 Modified to work on mac with MPW Fortran 2.1 C----------------------------------------------------------------------- Character CDate*9, CTime*8 C C The Date subroutine returns the current date in this form: DD-MMM-yy. C So we if yy is between 00 and 50, we assume that the first two digits are 20. C if yy is between 51 to 99, we assume that the first two digits are 19. C The Time subroutine returns the current time in this form: HH:MM:SS Call Date(CDate) Call Time(CTime) If ((CDate(8:9) .ge. '00') .and. (CDate(8:9) .le. '50')) Then String = CDate(1:7)//'20'//CDate(8:9)//' '//CTime(1:5) Else String = CDate(1:7)//'19'//CDate(8:9)//' '//CTime(1:5) End If L = MIN(17,LEN(STRING)) Return END pgplot/sys_mac/grgenv.f010064400040640000322000000077330607054261700156500ustar00tjpcitmbr00000400000017 C*GRGENV -- get value of PGPLOT environment parameter (MAC) C+ SUBROUTINE GRGENV(NAME, VALUE, L) CHARACTER*(*) NAME, VALUE INTEGER L C C Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, C environment parameters are UNIX environment variables; e.g. parameter C ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not C recursive and is case-sensitive. C C Arguments: C NAME : (input) the name of the parameter to evaluate. C VALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C L : receives the number of characters in VALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C C On Macintosh, the environment variables are stored in file. This subroutine C first looks for the file PGPLOTENVNAMES, in the application directory. C If it can't be found, a standard file dialog box will be displayed, C so that you can find the file. Once it is found, the name and location are C stored so that you will not be prompted again. C-- C 19-Jan-1988 C 25-Sep-1995 Modified to work on mac with MPW Fortran 2.1. All environment C parameters are stored in the file. The file can have any name C but best thing to do is to put a file called pgplotenvnames C in the application directory. See Tech. Note 35 for more information C about Macintosh file system. Note: this subroutine C needs to be compiled with the -u switch to initialize volrefnum C to zero, since a value less than zero specifies a folder. C----------------------------------------------------------------------- INTEGER LIN, LUN,LStart,VolRefNum, JVRefNum CHARACTER*32 TEST, Line*120, FilNam*120 External JVRefNum Save FileName,VolRefNum C TEST = 'PGPLOT_'//NAME LIN = INDEX(TEST, ' ')-1 Value = ' ' L = 0 Call GrgLun(LUN) C If volume reference number has been set, switch to that volume. The C first time grgenv is called, volrefnum will not be set and the current C directory is the application directory. The volume reference number will C be set after pgplotenvnames is found. If (VolRefNum .lt. 0) Then Call F_SETVOLUME(VolRefNum) End If C Try to open FilNam. The first time that Grgenv is called Filnam will C be empty and the open will fail. So try to open pgplotenvnames in the C current directory. If that fails put up a standard file dialog box to C find pgplotenvnames. If FilNam has been set then after assigning a C unit number to the file reset the volume reference number to the application C directory. Open(Unit = lun,File=FilNam,Status='OLD',Err = 10,Readonly) Call F_SETVOLUME(JVREFNUM(-1)) Go to 1 10 Open(Unit = lun,File='pgplotenvnames',Status='OLD',Err = 20,Readonly) FilNam = 'pgplotenvnames' VolRefNum = JVREFNUM(Lun) Go to 1 C Put up standard file dialog box. Once found store the file name and volume C reference number. 20 CALL GRWARN('Could not find file PGPLOTENVNAMES in current directory.') CALL GRWARN('A dialog box will come up allowing you to find the file with the') CALL GRWARN('environment variables. Hit return for the dialog box to appear.') Pause Open(Unit=lun,File=*,STATUS='OLD',err=100,Readonly) Inquire(Unit=LUN,Name=FilNam) VolRefNum = JVREFNUM(Lun) C File has been found, so search for environmental variable and extract value. 1 Continue Read(Lun,'(A512)',End=2) Line If (Test(:Lin) .EQ. Line(:Lin)) Then Lstart = index(Line,"'")+1 L = index(Line(Lstart:),"'")-1 Value = Line(LStart:LStart+L-1) Close(Lun) Go to 2 End If Go to 1 2 Close(LUN) Return C Could not find PGPLOTENVNAMES. 100 Close(LUN) CALL GRWARN('Cancelled dialog box to find PGPLOTENVNAMES') Return END pgplot/sys_mac/grgfil.f010064400040640000322000000055200571073604100156160ustar00tjpcitmbr00000400000017C*GRGFIL -- find data file C+ SUBROUTINE GRGFIL(TYPE, NAME) CHARACTER*(*) TYPE, NAME C C This routine encsapsulates the algorithm for finding the PGPLOT C run-time data files. C C 1. The binary font file: try the following in order: C file specified by PGPLOT_FONT C file in DEFFNT in directory specified by PGPLOT_DIR C with or without a : appended to the end. C file in DEFFNT in directory specified by DEFDIR C file in DEFFNT in current directory. C C 2. The color-name database: try the following in order: C file specified by PGPLOT_RGB C file in DEFRGB in directory specified by PGPLOT_DIR C with or without a : appended to the end. C file in DEFRGB in directory specified by DEFDIR C file in DEFRGB" in current directory. C C Arguments: C TYPE (input) : either 'FONT' or 'RGB' to request the corresponding C file. C NAME (output) : receives the file name. C-- C 2-Dec-1994 - new routine [TJP]. C 21-Jan-1995 - Modified to work on Macintosh with MPW Fortran 2.1 C----------------------------------------------------------------------- CHARACTER*(*) DEFDIR, DEFFNT, DEFRGB PARAMETER (DEFDIR=':fonts:') PARAMETER (DEFFNT='grfont.dat') PARAMETER (DEFRGB='rgb.txt') CHARACTER*255 FF CHARACTER*16 DEFLT INTEGER I, L, LD LOGICAL TEST, DEBUG C C Is debug output requested? C CALL GRGENV('DEBUG', FF, L) DEBUG = L.GT.0 C C Which file? C IF (TYPE.EQ.'FONT') THEN DEFLT = DEFFNT LD = LEN(DEFFNT) ELSE IF (TYPE.EQ.'RGB') THEN DEFLT = DEFRGB LD = LEN(DEFRGB) ELSE CALL GRWARN('Internal error in routine GRGFIL') END IF C C Try each possibility in turn. C DO 10 I=1,5 IF (I.EQ.1) THEN CALL GRGENV(TYPE, FF, L) ELSE IF (I.EQ.2) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:) = DEFLT L = L+LD END IF ELSE IF (I.EQ.3) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:L+1) = ':' FF(L+2:) = DEFLT L = L+1+LD END IF ELSE IF (I.EQ.4) THEN FF = DEFDIR//DEFLT L = LEN(DEFDIR)+LD ELSE IF (I.EQ.5) THEN FF = DEFLT L = LD END IF IF (L.GT.0) THEN IF (DEBUG) CALL GRWARN('Looking for '//FF(:L)) INQUIRE (FILE=FF(:L), EXIST=TEST) IF (TEST) THEN NAME = FF(:L) RETURN ELSE IF (DEBUG) THEN CALL GRWARN('WARNING: file not found') END IF END IF 10 CONTINUE C C Failed to find the file. C NAME = DEFLT C----------------------------------------------------------------------- END pgplot/sys_mac/grgmem.f010064400040640000322000000020720606631262700156260ustar00tjpcitmbr00000400000017!!G Toolbox.finc C If you have a power mac version of LS fortran uncomment the C next 5 lines and comment out "!!MP InLines.f" C!!IFC NOT LSPOWERF C!!MP 68KInlines C!!ELSEC C!!MP PPCInlines C!!ENDC C If you have a 68K mac version of LS fortran comment out the C 5 lines above and uncomment the next line. !!MP InLines.f C Fortran callable memory allocator C Called as : C ier = grgmem (size,pointer) C where : size is an integer size of memory to allocate C pointer is an integer to return the pointer into Integer Function GRGMEM(size, pointer) Integer*4 size, pointer pointer = NewPtr(Size) If (pointer .eq. 0) Then grgmem = 0 Else grgmem = 1 End if Return End C Fortran callable memory deallocator C Called as : C ier = grfmem (size,pointer) C where : size is an integer size of memory to deallocate (not used) C pointer is an integer that contains the pointer Integer Function GRFMEM(size, pointer) Integer*4 size, pointer Call DisposPtr(Pointer) grfmem = 1 Return Endpgplot/sys_mac/gropen.f010064400040640000322000000115310607652745500156520ustar00tjpcitmbr00000400000017C*GROPEN -- open device for graphics C+ INTEGER FUNCTION GROPEN (TYPE,DUMMY,FILE,IDENT) INTEGER TYPE, DUMMY, IDENT CHARACTER*(*) FILE C C GRPCKG: assign a device and prepare for plotting. GROPEN must be C called before all other calls to GRPCKG routines. C C Returns: C C GROPEN (output, integer): 1 => success, any other value C indicates a failure (usually the value returned will C be a VMS error code). In the event of an error, a C message will be sent to the standard error unit. C C Arguments: C C TYPE (input, integer): default device type (integer code). C DUMMY (input, integer): not used at present. C FILE (input, character): plot specifier, of form 'device/type'. C IDENT (output, integer): plot identifier to be used in later C calls to GRPCKG. C C 1-Jun-1984 - [TJP]. C 2-Jul-1984 - change to call GRSLCT [TJP]. C 13-Jul-1984 - add device initialization [TJP]. C 23-Jul-1984 - add /APPEND qualifier. C 19-Oct-1984 - add VV device [TJP]. C 26-Dec-1984 - obtain default file name from common [TJP]. C 29-Jan-1985 - add HP2648 device [KS/TJP]. C 5-Aug-1986 - add GREXEC support [AFT]. C 12-Oct-1986 - fix bug causing GREXEC to erase screen [AFT]. C 3-Jun-1987 - remove declaration of exit handler [TJP]. C 15-Dec-1988 - standardize [TJP]. C 25-Jun-1989 - remove code that removes spaces from the device name C [TJP]. C 26-Nov-1990 - [TJP]. C 5-Jan-1993 - [TJP]. C 1-Sep-1994 - store device capabilities in common for later use [TJP]. C 17-Apr-1995 - zero-length string fix [TJP]. C 6-Jun-1995 - explicitly initialize GRSTAT [TJP]. C----------------------------------------------------------------------- INCLUDE 'grpckg1.inc' INTEGER IER, FTYPE, NBUF, LCHR INTEGER GRPARS, GRTRIM REAL RBUF(6) LOGICAL FNTOPN, APPEND CHARACTER*128 FFILE,CHR SAVE FNTOPN DATA FNTOPN / .TRUE. / C C Move the initialization of grstat to a block data subprogram in C pgblck file. John S. Salmento 7/5/95 CC C Initialize character-drawing routines (first call to GROPEN only). C IF (FNTOPN) THEN CALL GRSY00 FNTOPN = .FALSE. END IF C C Allocate an identifier. C IDENT = 1 10 IF (GRSTAT(IDENT).NE.0) THEN IDENT = IDENT+1 IF (IDENT.GT.GRIMAX) THEN CALL GRWARN('Too many active plots.') GROPEN = -1 IDENT = 0 RETURN END IF GOTO 10 END IF GRCIDE = IDENT C C Validate the device specification. C IER = GRPARS(FILE,FFILE,FTYPE,APPEND) IF (IER.NE.1) THEN CHR = 'Invalid device specification: ' CHR(31:) = FILE CALL GRWARN(CHR) GROPEN = -1 RETURN END IF IF (FTYPE.EQ.0) FTYPE = TYPE IF (1.LE.FTYPE) THEN GRTYPE(IDENT) = FTYPE GRGTYP = FTYPE ELSE CHR = 'Device type omitted or invalid: ' CHR(33:) = FILE CALL GRWARN(CHR) GROPEN = -1 RETURN END IF C C Install the file name, or assign default. C IF (FFILE.EQ.' ') THEN CALL GREXEC(GRGTYP, 5,RBUF,NBUF,FFILE,LCHR) END IF GRFILE(IDENT) = FFILE GRFNLN(IDENT) = MAX(1,GRTRIM(GRFILE(IDENT))) C C Open workstation. C RBUF(3)=0 IF (APPEND) RBUF(3)=1 NBUF=3 CALL GREXEC(GRGTYP, 9,RBUF,NBUF, GRFILE(IDENT),GRFNLN(IDENT)) GRUNIT(IDENT)=RBUF(1) GROPEN=RBUF(2) IF (GROPEN.NE.1) RETURN GRPLTD(IDENT) = .FALSE. C C Install the default plot parameters C C--- Inquire color-index range. CALL GREXEC(GRGTYP, 2,RBUF,NBUF,CHR,LCHR) GRMNCI(IDENT)=RBUF(5) GRMXCI(IDENT)=RBUF(6) C--- Inquire resolution. CALL GREXEC(GRGTYP, 3,RBUF,NBUF,CHR,LCHR) GRPXPI(IDENT)=RBUF(1) GRPYPI(IDENT)=RBUF(2) C--- Inquire default character size. CALL GREXEC(GRGTYP, 7,RBUF,NBUF,CHR,LCHR) GRCSCL(IDENT) = RBUF(1) GRCFAC(IDENT) = RBUF(1) C--- Inquire default plot size. CALL GREXEC(GRGTYP, 6,RBUF,NBUF,CHR,LCHR) GRXMXA(IDENT) = RBUF(2) GRYMXA(IDENT) = RBUF(4) GRXMIN(IDENT) = RBUF(1) GRXMAX(IDENT) = RBUF(2) GRYMIN(IDENT) = RBUF(3) GRYMAX(IDENT) = RBUF(4) C--- Inquire device capabilities. CALL GREXEC(GRGTYP, 4,RBUF,NBUF,CHR,LCHR) GRGCAP(IDENT) = CHR(:LCHR) C--- Current pen position. GRXPRE(IDENT) = 0.0 GRYPRE(IDENT) = 0.0 C--- GRSETS has not been called. GRADJU(IDENT) = .FALSE. C---Default scaling. CALL GRTRN0(0.0, 0.0, 1.0, 1.0) C GRSTAT(IDENT) = 1 CALL GRSLCT(IDENT) C C Default attributes. C text font (normal) C color (white) C line-style (full) C line-width (minimum) C marker number (dot) C GRCFNT(GRCIDE) = 1 GRCCOL(GRCIDE) = 1 GRSTYL(GRCIDE) = 1 GRWIDT(GRCIDE) = 1 GRCMRK(GRCIDE) = 1 GRDASH(GRCIDE) = .FALSE. C GROPEN = 1 C END pgplot/sys_mac/grsy00.f010064400040640000322000000075350571074405300155020ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C 21-Jan-1995 Modified to work on Mac with MPW Fortran 2.1 (Ie. Split grfont.dat into C 3 records, since maximum record length is 32,767). C----------------------------------------------------------------------- CHARACTER*(*) DEFNAM PARAMETER (DEFNAM='grfont.dat') INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) Then C MPW Fortran 2.1 has a maximum record size of 32767 bytes for multiple items in an C unformatted I/O statement. So put NC1, NC2, LOC, and INDEX in one record (The total C length will be 4 * (1 + 1 + 1 + 3000) = 12,012 bytes. Split Index in two put them each C in a record. The length will be 2 * 13500 = 27,000. READ (UNIT=FNTFIL, IOSTAT=IER) NC1,NC2,NC3,INDEX Read (UNIT=FNTFIL, IOSTAT=IER) (Buffer(I), I = 1,13500) Read (UNIT=FNTFIL, IOSTAT=IER) (Buffer(I), I = 13501,27000) End If IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file,') Call GRWARN('Or put grfont.dat in your current directory.') END IF RETURN END n-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move fopgplot/sys_mac/grtrml.f010064400040640000322000000011750602171341600156520ustar00tjpcitmbr00000400000017 C*GRTRML -- get name of user's terminal (UNIX) C+ SUBROUTINE GRTRML(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the device name of the user's terminal, if any. C C Arguments: C STRING : receives the terminal name, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 19-Jan-1988 C 21-Jan-1995 Returns Mac Window C----------------------------------------------------------------------- STRING = 'MacWindow' L =9 END pgplot/sys_mac/gruser.f010064400040640000322000000020040606631256700156550ustar00tjpcitmbr00000400000017!!G Toolbox.finc C If you have a power mac version of LS fortran uncomment the C next 5 lines and comment out "!!MP InLines.f" C!!IFC NOT LSPOWERF C!!MP 68KInlines C!!ELSEC C!!MP PPCInlines C!!ENDC C If you have a 68K mac version of LS fortran comment out the C 5 lines above and uncomment the next line. !!MP InLines.f C*GRUSER -- get user name (Macintosh) C+ SUBROUTINE GRUSER(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the name of the user running the program. C On Macintosh get user name in from resource -16096. This is set C with the Sharing Setup control panel. C C Arguments: C STRING : receives user name, truncated or extended with C blanks as necessary. C L : receives the number of characters in VALUE, excluding C trailing blanks. C-- C----------------------------------------------------------------------- Record /StringHandle/ UserName UserName = GetString(int2(-16096)) STRING = UserName.h^.P^ L = len(trim(string)) END pgplot/sys_mac/hgdriv.f010064400040640000322000000311560577654766600156640ustar00tjpcitmbr00000400000017C*HGDRIV -- PGPLOT HPGL-2 driver C+ SUBROUTINE HGDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C----------------------------------------------------------------------- C PGPLOT driver for HPGL-2 device. C----------------------------------------------------------------------- C Version 0.0 - 1990 Oct 18 - C. J. Lonsdale. C----------------------------------------------------------------------- C C This driver should work with any HP-GL/2 device, but has been tested C only with a Laserjet III printer. It takes advantage of the "PE" mode C compressed data format. In the Laserjet III used for testing, there C were two problems with using the PE format, both of which required C inelegant workarounds in the code. First, the PE mode is designed C to be used with relative addressing, but when PGPLOT tries to draw long C dashed/dotted lines there seems to be a systematic rounding error C internal to the printer which grows as n instead of sqrt(n), so that C serious cumulative positional errors can result. Attempts to work C around this by periodically inserting an absolute positioning command C revealed a second problem, namely that the "=" absolute positioning C flag in PE mode does not work. It was thus necessary to periodically C exit from PE mode, do absolute positioning in normal mode, then return C to PE mode. The file size overhead of this workaround is miminal (maybe C 5%). The printer rounding errors were ignored in the polygon fill C opcode, because in general the vectors will be of pseudo-random length C and direction, so errors will grow only as sqrt(n). C C Supported device: Any HPGL-2 device (presently tested only on HP laserjet 3) C C Device type code: /HPGL2 C C Default device name: PGPLOT.HGPLOT. C C Default view surface dimensions: 8.0in (horizontal) by 10.0in C (vertical). C C Resolution: 1016 (x) x 1016 (y) pixels/inch. C C Color capability: Color indices 0 (erase, white) and 1 (black) are C supported. 7 other shades of grey are available for lines and C area fill patterns. C It is not possible to change color representation. C C Input capability: None. C C File format: Ascii C C Obtaining hardcopy: Extremely system dependent C----------------------------------------------------------------------- CHARACTER*(*) TYPE, DEFNAM PARAMETER (TYPE='HPGL2 (Hewlett-Packard graphics)') PARAMETER (DEFNAM='PGPLOT.HGPLOT') CHARACTER*1 FF, EC PARAMETER (FF=CHAR(12)) PARAMETER (EC=CHAR(27)) C LOGICAL START, PEON INTEGER GROPTX INTEGER UNIT, IER, IC, NPTS, PCT, NREL INTEGER I0, J0, I1, J1, L, L1, L2, LASTI, LASTJ, LOBUF REAL LW CHARACTER*80 INSTR, MSG, DUMMY, DUMMY1, DUMMY2 CHARACTER*132 OBUF SAVE UNIT, IC, LASTI, LASTJ, LOBUF, OBUF, PEON, NREL C----------------------------------------------------------------------- C GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230), IFUNC 900 WRITE (MSG,'(I10)') IFUNC CALL GRWARN('Unimplemented function in '//TYPE//' device driver:' 1 //MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CHR = TYPE LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 RBUF(1) = 0 RBUF(2) = 8128 RBUF(3) = 0 RBUF(4) = 10160 RBUF(5) = 0 RBUF(6) = 9 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 RBUF(1) = 1016.0 RBUF(2) = 1016.0 RBUF(3) = 1 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, No dashed lines, Area fill, C Thick lines) C 40 CHR = 'HNNATNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CHR = DEFNAM LCHR = LEN(DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 RBUF(1) = 0 RBUF(2) = 8128 RBUF(3) = 0 RBUF(4) = 10160 NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 RBUF(1) = 1 NBUF=1 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT IER = GROPTX(UNIT, CHR(1:LCHR), DEFNAM, 1) IF (IER.NE.0) THEN DUMMY = CHR(:LCHR) CALL GRWARN('Cannot open output file for '//TYPE//' plot: '// 1 DUMMY(:LCHR)) RBUF(2) = 0 CALL GRFLUN(UNIT) RETURN ELSE INQUIRE (UNIT=UNIT, NAME=CHR) LCHR = LEN(CHR) 91 IF (CHR(LCHR:LCHR).EQ.' ') THEN LCHR = LCHR-1 GOTO 91 END IF RBUF(2) = 1 END IF CALL GRHG02(UNIT,EC//'E') PEON = .FALSE. NREL = 0 RETURN C C--- IFUNC=10, Close workstation --------------------------------------- C 100 CONTINUE CLOSE(UNIT) CALL GRFLUN(UNIT) RETURN C C--- IFUNC=11, Begin picture ------------------------------------------- C C Enter HPGL, black pen, thick lines have rounded ends and joins 110 CONTINUE CALL GRHG02(UNIT,EC//'%0BINSP1LA1,4,2,4PA1,1') LASTI = 1 LASTJ = 1 RETURN C C--- IFUNC=12, Draw line ----------------------------------------------- C 120 CONTINUE I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) I1 = NINT(RBUF(3)) J1 = NINT(RBUF(4)) C simple pen-down move IF (I0.EQ.LASTI .AND. J0.EQ.LASTJ) THEN CALL GRHGEC((I1-I0), (J1-J0), INSTR, L) C pen up to start of line, then pen down to end of line ELSE CALL GRHGEC((I0-LASTI), (J0-LASTJ), DUMMY1, L1) CALL GRHGEC((I1-I0), (J1-J0), DUMMY2, L2) INSTR = '<'//DUMMY1(1:L1)//DUMMY2(1:L2) L = 1 + L1 + L2 C Make sure we are doing this in PE mode END IF IF(.NOT. PEON) THEN INSTR = 'PE7'//INSTR L = L + 3 PEON = .TRUE. NREL = 0 ENDIF LASTI = I1 LASTJ = J1 C Insert absolute position once in a while to keep LJIII in line NREL = NREL + 1 IF(NREL .GE. 30) THEN CALL GRFAO(';PUPA#,#PE7',L1,DUMMY1,LASTI,LASTJ,0,0) INSTR = INSTR(1:L)//DUMMY1(1:L1) L = L + L1 NREL = 0 ENDIF GOTO 800 C C--- IFUNC=13, Draw dot ------------------------------------------------ C 130 CONTINUE I1 = NINT(RBUF(1)) J1 = NINT(RBUF(2)) C pen up move to position, then pen down CALL GRHGEC((I1-LASTI), (J1-LASTJ), DUMMY1, L1) CALL GRHGEC(0, 0, DUMMY2, L2) INSTR = '<'//DUMMY1(1:L1)//DUMMY2(1:L2) L = 1 + L1 + L2 IF(.NOT. PEON) THEN INSTR = 'PE7'//INSTR L = L + 3 PEON = .TRUE. NREL = 0 ENDIF LASTI = I1 LASTJ = J1 C LJIII obedience code as in line draw opcode NREL = NREL + 1 IF(NREL .GE. 30) THEN CALL GRFAO(';PUPA#,#PE7',L1,DUMMY1,LASTI,LASTJ,0,0) INSTR = INSTR(1:L)//DUMMY1(1:L1) L = L + L1 NREL = 0 ENDIF GOTO 800 C C--- IFUNC=14, End picture --------------------------------------------- C 140 CONTINUE IF (LOBUF.NE.0) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF CALL GRHG02(UNIT, ';'//EC//'E') PEON = .FALSE. RETURN C C--- IFUNC=15, Select color index -------------------------------------- C 150 CONTINUE IC = RBUF(1) C white ... disable transparency mode. IF (IC.EQ.0) THEN INSTR = ';TR0SP0FT10,0SV0' L = 16 C Some shade of grey, enable transparency C Had to disable greys ... bad effects on line drawing CJL 3/6/92 ELSE PCT = 100 C IF(IC.EQ.1) PCT = 100 C IF(IC.EQ.2) PCT = 1 C IF(IC.EQ.3) PCT = 5 C IF(IC.EQ.4) PCT = 15 C IF(IC.EQ.5) PCT = 25 C IF(IC.EQ.6) PCT = 40 C IF(IC.EQ.7) PCT = 70 C IF(IC.EQ.8) PCT = 85 CALL GRFAO(';TR1SP1FT10,#SV1,#',L,INSTR,PCT,PCT,0,0) END IF PEON = .FALSE. GOTO 800 C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE IF (LOBUF.NE.0) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) LOBUF = 0 END IF RETURN C C--- IFUNC=17, Read cursor. -------------------------------------------- C (Not implemented: should not be called) C 170 CONTINUE GOTO 900 C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C (Not implemented: no alpha screen) C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C (Not implemented: should not be called) C 190 CONTINUE GOTO 900 C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE IF (NPTS.EQ.0) THEN NPTS = RBUF(1) START = .TRUE. RETURN ELSE NPTS = NPTS-1 I0 = NINT(RBUF(1)) J0 = NINT(RBUF(2)) C enter PE mode at first vertex IF (START) THEN CALL GRFAO(';PUPA#,#PMPE7', L, INSTR, I0, J0, 0, 0) START = .FALSE. LASTI = I0 LASTJ = J0 C last point, exit PE mode, polygon mode, and issue polygon fill. Then C reset the position to be safe. ELSE IF (NPTS.EQ.0) THEN CALL GRHGEC((I0-LASTI),(J0-LASTJ),DUMMY1,L1) INSTR = DUMMY1(1:L1)//';PM2FPPUPA1,1' L = L1 + 13 LASTI = 1 LASTJ = 1 PEON = .FALSE. NREL = 0 C Just another point ELSE CALL GRHGEC((I0-LASTI),(J0-LASTJ),INSTR,L) LASTI = I0 LASTJ = J0 END IF GOTO 800 ENDIF C C--- IFUNC=21, Set color representation. ------------------------------- C (Not implemented: ignored) C 210 CONTINUE RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE C Fudged this ... lines looked too thick, maybe its the res. enhancement. LW = RBUF(1) * 0.127 - 0.05 IF(LW .EQ. 0.0) LW = 0.025 WRITE(DUMMY,'(F5.3)') LW INSTR = ';PW'//DUMMY L = 8 PEON = .FALSE. GOTO 800 C C--- IFUNC=23, Escape -------------------------------------------------- C (Not implemented: ignored) C 230 CONTINUE RETURN C----------------------------------------------------------------------- C Buffer output if possible. Same as PS driver. C 800 IF ( (LOBUF+L+1). GT. 132) THEN CALL GRHG02(UNIT, OBUF(1:LOBUF)) OBUF(1:L) = INSTR(1:L) LOBUF = L ELSE OBUF(LOBUF+1:LOBUF+L) = INSTR(1:L) LOBUF = LOBUF+L END IF RETURN C----------------------------------------------------------------------- END C*GRHGEC -- PGPLOT HPGL2 driver, convert integers to coded ascii C+ SUBROUTINE GRHGEC(X,Y,OUTSTR,L) C C Support routine for HPGL2 driver: converts integer coordinates C X and Y to base 32 in the ascii format suitable for PE command. C Output is a string, number of characters encoded returned in L. C---------------------------------------------------------------- INTEGER X, Y, L CHARACTER*(*) OUTSTR C INTEGER XREM, YREM C C Set the sign bit C X = X * 2 IF(X .LT. 0) X = 1 - X Y = Y * 2 IF(Y .LT. 0) Y = 1 - Y C C Loop through base-32 digits, treat last one with extra bit in C ascii character. Goes from least to most significant. C L = 0 OUTSTR = ' ' 10 CONTINUE XREM = MOD(X,32) X = X / 32 L = L + 1 IF(X .EQ. 0) GO TO 20 OUTSTR(L:L) = CHAR(63+XREM) GO TO 10 20 OUTSTR(L:L) = CHAR(95+XREM) C C Do Y coordinate same way as X above C 30 CONTINUE YREM = MOD(Y,32) Y = Y / 32 L = L + 1 IF(Y .EQ. 0) GO TO 40 OUTSTR(L:L) = CHAR(63+YREM) GO TO 30 40 OUTSTR(L:L) = CHAR(95+YREM) C RETURN END C*GRHG02 -- PGPLOT HPGL driver, copy buffer to file C+ SUBROUTINE GRHG02 (UNIT, S) C C Support routine for PSdriver: write character string S on C specified Fortran unit. C----------------------------------------------------------------------- INTEGER UNIT CHARACTER*(*) S C WRITE (UNIT, '(A)') S C----------------------------------------------------------------------- END pgplot/sys_mac/macmake010064400040640000322000000526570607260366700155440ustar00tjpcitmbr00000400000017Echo Usage: macmake ¶n¶ Expects current directory to be top level directory of the PGPLOT distribution. ¶n¶ Also sys_mac needs to be a subdirectory of current directory. ¶n¶ drivers.list needs to be in current directory. ¶n¶ Some error checking is done to ensure that all the files are in ¶n¶ their proper places. The library is built in current directory. ¶n¶ # PGPLOT source directories. #----------------------------------------------------------------------- Set SRCDIR :src: Set DEMDIR :examples: Set FNTDIR :fonts: Set DRVDIR :drivers: Set GENDIR :sys: Set SYSDIR :sys_mac: # FCOMPL contains the name of the fortran compiler. FFLAGC contains the # compiler options for the pgplot routines. FFLAGD contains the compiler # options used for the example programs. To produce 68020 or # or 68030 code, add -mc68020 to FFLAGC or FFLAGD. If you to produce # 68881 or 68882 code, add -mc68881 to FFLAGC or FFLAGD. If you do # use the 68020 or the 68881 then you should used them when compiling the # other files that are link with the pgplot library. If you use the 68881 # option then you also need to link in the FPU libraries, # {FLibraries}IntrinsicLibFPU.o", "{FLibraries}FSANELibFPU.o". FLINK contains # the name of the fortran link command used for creating the example programs. # If mc68881 is used to create pgplot.lib, change FLINK to LinkFortranFPU # instead of LinkFortran. However, I did not get pgdemo1 to work with mc68881. # The other example programs work fine. Set FCOMPL FORTRAN Set FFLAGC '-u -saveall -b -opt=0 -bkg=0 -mc68020' Set FFLAGD '-u -saveall -b -opt=0 -bkg=0 -mc68020' Set FLINK LinkFortran # FFLAGU contains the compiler options for create_grexec, create_doc, and # pgpack. FLINK contains the link options for these same programs. Using # the mc68881 compiler option probably will not speed up performance in # these programs because very little real operations are performed. I set # the optimization lower since compile time is more important. I also set # the background option higher since these programs do not call many # subroutines. Set FFLAGU '-opt=0 -bkg=3 -mc68020' # Determine name of script file which sets the memory partition size. If "{MPW}"Scripts:AddSizeResource == `Exists -f "{MPW}"Scripts:AddSizeResource` Set SizRes AddSizeResource Else if "{MPW}"Scripts:Fsize == `Exists -f "{MPW}"Scripts:Fsize` Set SizRes Fsize Else Echo ¶nError: Could not find either AddSizeResource or Fsize in the "{MPW}"Scripts: ¶n¶ folder. They are needed to change the memory setting in the demo programs. ¶n Exit End # We need a drivers.list file in the current directory, from which to # determine the drivers to be compiled. If 'drivers.list' == `Exists -f drivers.list` Echo `Date -t` 'Selecting uncommented drivers from drivers.list' Else Echo `Date -t` 'Could not find drivers.list. Please specify required ' ¶n¶ 'drivers by un-commenting them in drivers.list. Then re-run' Exit 1 End # Get a list of driver names. Set driv_list '' Echo `Date -t` "Found drivers" For Driver in `Search -q -r ! drivers.list | Sort -unique -f 1 | StreamEdit -e '/DRIV/ Replace /DRIVÅ/ "DRIV"'` Set driv_list "{driv_list} {Driver}.f" Echo {Driver}'.f' End # Language Systems FORTRAN compiler expects their include files to appear in the # directory in which you actually do the compilation. Duplicate -y {SRCDIR}Å.inc : #----------------------------------------------------------------------- # Routine lists: # PG_ROUTINES: basic PGPLOT routines (Fortran-77). # PG_NON_STANDARD: non-Fortran-77 aliases for basic routines. # GR_ROUTINES: support routines, not called directly by applications # (Fortran-77). # SYSTEM_ROUTINES: potentially non-portable routines, usually # operating-system dependent. # OBSOLETE_ROUTINES: obsolete routines used by some programs. # DEMOS: demonstration programs #----------------------------------------------------------------------- Set PG_ROUTINES "¶ pgarro.f ¶ pgask.f ¶ pgband.f ¶ pgbbuf.f ¶ pgbeg.f ¶ pgbin.f ¶ pgbox.f ¶ pgbox1.f ¶ pgcirc.f ¶ pgcl.f ¶ pgcn01.f ¶ pgcnsc.f ¶ pgconb.f ¶ pgconl.f ¶ pgcons.f ¶ pgcont.f ¶ pgconx.f ¶ pgcp.f ¶ pgctab.f ¶ pgcurs.f ¶ pgdraw.f ¶ pgebuf.f ¶ pgend.f ¶ pgenv.f ¶ pgeras.f ¶ pgerrb.f ¶ pgerrx.f ¶ pgerry.f ¶ pgetxt.f ¶ pgfunt.f ¶ pgfunx.f ¶ pgfuny.f ¶ pggray.f ¶ pghi2d.f ¶ pghis1.f ¶ pghist.f ¶ pghtch.f ¶ pgiden.f ¶ pgimag.f ¶ pglab.f ¶ pglcur.f ¶ pgldev.f ¶ pglen.f ¶ pgline.f ¶ pgmove.f ¶ pgmtxt.f ¶ pgncur.f ¶ pgnoto.f ¶ pgnpl.f ¶ pgnumb.f ¶ pgolin.f ¶ pgpage.f ¶ pgpanl.f ¶ pgpap.f ¶ pgpixl.f ¶ pgpnts.f ¶ pgpoly.f ¶ pgpt.f ¶ pgptxt.f ¶ pgqah.f ¶ pgqcf.f ¶ pgqch.f ¶ pgqci.f ¶ pgqcir.f ¶ pgqcol.f ¶ pgqcr.f ¶ pgqcs.f ¶ pgqfs.f ¶ pgqhs.f ¶ pgqinf.f ¶ pgqitf.f ¶ pgqls.f ¶ pgqlw.f ¶ pgqpos.f ¶ pgqtbg.f ¶ pgqtxt.f ¶ pgqvp.f ¶ pgqvsz.f ¶ pgqwin.f ¶ pgrect.f ¶ pgrnd.f ¶ pgrnge.f ¶ pgsah.f ¶ pgsave.f ¶ pgscf.f ¶ pgsch.f ¶ pgsci.f ¶ pgscir.f ¶ pgscr.f ¶ pgscrn.f ¶ pgsfs.f ¶ pgshls.f ¶ pgshs.f ¶ pgsitf.f ¶ pgsls.f ¶ pgslw.f ¶ pgstbg.f ¶ pgsubp.f ¶ pgsvp.f ¶ pgswin.f ¶ pgtbox.f ¶ pgtext.f ¶ pgupdt.f ¶ pgvect.f ¶ pgvsiz.f ¶ pgvstd.f ¶ pgvw.f ¶ pgwedg.f ¶ pgwnad.f ¶ " Set PG_NON_STANDARD "¶ pgadvance.f ¶ pgbegin.f ¶ pgcurse.f ¶ pglabel.f ¶ pgmtext.f ¶ pgncurse.f ¶ pgpaper.f ¶ pgpoint.f ¶ pgptext.f ¶ pgvport.f ¶ pgvsize.f ¶ pgvstand.f ¶ pgwindow.f ¶ " Set GR_ROUTINES "¶ grarea.f ¶ grbpic.f ¶ grchsz.f ¶ grclip.f ¶ grclos.f ¶ grclpl.f ¶ grctoi.f ¶ grcurs.f ¶ grdot0.f ¶ grdtyp.f ¶ gresc.f ¶ grepic.f ¶ gretxt.f ¶ grfa.f ¶ grfao.f ¶ grgfil.f ¶ grgray.f ¶ grimg0.f ¶ grimg1.f ¶ grimg2.f ¶ grimg3.f ¶ gritoc.f ¶ grldev.f ¶ grlen.f ¶ grlin0.f ¶ grlin1.f ¶ grlin2.f ¶ grlin3.f ¶ grlina.f ¶ grmcur.f ¶ grmker.f ¶ grmova.f ¶ grmsg.f ¶ gropen.f ¶ grpage.f ¶ grpars.f ¶ grpixl.f ¶ grpocl.f ¶ grprom.f ¶ grpxpo.f ¶ grpxps.f ¶ grpxpx.f ¶ grpxre.f ¶ grqcap.f ¶ grqci.f ¶ grqcol.f ¶ grqcr.f ¶ grqdev.f ¶ grqdt.f ¶ grqfnt.f ¶ grqls.f ¶ grqlw.f ¶ grqpos.f ¶ grqtxt.f ¶ grqtyp.f ¶ grquit.f ¶ grrec0.f ¶ grrect.f ¶ grsci.f ¶ grscr.f ¶ grsetc.f ¶ grsets.f ¶ grsfnt.f ¶ grsize.f ¶ grskpb.f ¶ grslct.f ¶ grsls.f ¶ grslw.f ¶ grsyds.f ¶ grsymk.f ¶ grsyxd.f ¶ grterm.f ¶ grtext.f ¶ grtoup.f ¶ grtrim.f ¶ grtrn0.f ¶ grtxy0.f ¶ grvct0.f ¶ grwarn.f ¶ grxhls.f ¶ grxrgb.f ¶ " Set SYSTEM_ROUTINES "¶ grdate.f ¶ grflun.f ¶ grgcom.f ¶ grgenv.f ¶ grglun.f ¶ grgmem.f ¶ grgmsg.f ¶ grlgtr.f ¶ groptx.f ¶ grsy00.f ¶ grtrml.f ¶ grtter.f ¶ gruser.f ¶ " Set OBSOLETE_ROUTINES "¶ grchar.f ¶ grchr0.f ¶ grdat2.f ¶ grgtc0.f ¶ grinqfont.f ¶ grinqli.f ¶ grinqpen.f ¶ grlinr.f ¶ grmark.f ¶ grmovr.f ¶ grsetfont.f ¶ grsetli.f ¶ grsetpen.f ¶ grtran.f ¶ grvect.f ¶ pgsetc.f ¶ pgsize.f ¶ " Set DEMOS "¶ pgdemo1 ¶ pgdemo2 ¶ pgdemo3 ¶ pgdemo4 ¶ pgdemo5 ¶ pgdemo6 ¶ pgdemo7 ¶ pgdemo8 ¶ pgdemo9 ¶ pgdemo10 ¶ pgdemo11 ¶ pgdemo12 ¶ " Set MAC_ROUTINES "pgblck.f" Begin Echo -n "# Makefile for PGPLOT. ¶n¶ # This file is automatically generated. ¶n¶ # ¶n¶ # This generates the PGPLOT binary files (libraries and demos) in the ¶n¶ # current default directory. ¶n¶ #----------------------------------------------------------------------- ¶n¶ # PGPLOT subdirectories ¶n¶ SRCDIR = {SRCDIR} ¶n¶ DEMDIR = {DEMDIR} ¶n¶ FNTDIR = {FNTDIR} ¶n¶ DRVDIR = {DRVDIR} ¶n¶ SYSDIR = {SYSDIR} ¶n¶ GENDIR = {GENDIR} ¶n¶ # ¶n¶ # FCOMPL contains the name of the fortran compiler. FFLAGC contains the ¶n¶ # compiler options for the pgplot routines. FFLAGD contains the compiler ¶n¶ # options used for the example programs. To produce 68020 or ¶n¶ # or 68030 code, add -mc68020 to FFLAGC or FFLAGD. If you to produce ¶n¶ # 68881 or 68882 code, add -mc68881 to FFLAGC or FFLAGD. If you do ¶n¶ # use the 68020 or the 68881 then you should used them when compiling the ¶n¶ # other files that are link with the pgplot library. If you use the 68881 ¶n¶ # option then you also need to link in the FPU libraries, ¶n¶ # "{FLibraries}IntrinsicLibFPU.o", "{FLibraries}FSANELibFPU.o". FLINK contains ¶n¶ # the name of the fortran link command used for creating the example programs. ¶n¶ # If mc68881 is used to create pgplot.lib, change FLINK to LinkFortranFPU ¶n¶ # instead of LinkFortran. However, I did not get pgdemo1 to work with mc68881. ¶n¶ # The other example programs work fine. ¶n¶ # FFLAGU contains the compiler options for create_grexec, create_doc, and ¶n¶ # pgpack. FLINK contains the link options for these same programs. Using ¶n¶ # the mc68881 compiler option probably will not speed up performance in ¶n¶ # these programs because very little real operations are performed. I set ¶n¶ # the optimization lower since compile time is more important. I also set ¶n¶ # the background option higher since these programs do not call many ¶n¶ # subroutines. ¶n¶ # ¶n¶ FCOMPL = {FCOMPL} ¶n¶ FFLAGC = {FFLAGC} ¶n¶ FFLAGD = {FFLAGD} ¶n¶ FFLAGU = {FFLAGU} ¶n¶ FLINK = {FLINK} ¶n¶ # ¶n¶ # Name of script to set memory size in demo programs. ¶n¶ # ¶n¶ SizRes = {SizRes} ¶n¶ # ¶n¶ # Routine lists. ¶n¶ # ¶n¶ " End > pgplot.make Echo `Date -t` "Finding files in PG Standard routines" Begin Set PG_ROUTINES_F "" Quote -n PG_ROUTINES = For files in {PG_ROUTINES} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set PG_ROUTINES_f "{PG_ROUTINES_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set PG_ROUTINES_f "{PG_ROUTINES_f} ¶{SRCDIR¶}{FILES}" Echo -n ¶t¶t '{SRCDIR}'{files}.o End End Echo Echo End >> pgplot.make Echo `Date -t` "Finding files in PG Non Standard routines" Begin Set PG_NON_STANDARD_f "" Quote -n PG_NON_STANDARD = For files in {PG_NON_STANDARD} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set PG_NON_STANDARD_f "{PG_NON_STANDARD_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set PG_NON_STANDARD_f "{PG_NON_STANDARD_f} ¶{SRCDIR¶}{FILES}" Echo -n ¶t¶t '{SRCDIR}'{files}.o End End Echo Echo End >> pgplot.make Echo `Date -t` "Finding files in GR Routines" Begin Set GR_ROUTINES_f "" Quote -n GR_ROUTINES = For files in {GR_ROUTINES} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set GR_ROUTINES_f "{GR_ROUTINES_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set GR_ROUTINES_f "{GR_ROUTINES_f} ¶{SRCDIR¶}{FILES}" Echo -n ¶t¶t '{SRCDIR}'{files}.o End End Echo Echo End >> pgplot.make Echo `Date -t` "Finding files in System Routines" Begin Set SYSTEM_ROUTINES_f "" Quote -n SYSTEM_ROUTINES = For files in {SYSTEM_ROUTINES} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set SYSTEM_ROUTINES_f "{SYSTEM_ROUTINES_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set SYSTEM_ROUTINES_f "{SYSTEM_ROUTINES_f} ¶{GENDIR¶}{FILES}" Echo -n ¶t¶t '{GENDIR}'{files}.o End End Echo Echo End >> pgplot.make Echo `Date -t` "Finding files in Driver Routines" Begin Set Driv_list_f "" Quote -n DRIV_LIST = For files in {driv_list} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set Driv_list_f "{Driv_list_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set Driv_list_f "{Driv_list_f} ¶{DRVDIR¶}{FILES}" Echo -n ¶t¶t '{DRVDIR}'{files}.o End End Echo Echo End >> pgplot.make Echo `Date -t` "Finding files in Obsolete Routines" Begin Set OBSOLETE_ROUTINES_f "" Quote -n OBSOLETE_ROUTINES = For files in {OBSOLETE_ROUTINES} Echo ' ¶' If {SYSDIR}{files} == `Exists -f {SYSDIR}{files}` Set OBSOLETE_ROUTINES_f "{OBSOLETE_ROUTINES_f} ¶{SYSDIR¶}{FILES}" Echo -n ¶t¶t '{SYSDIR}'{files}.o Else Set OBSOLETE_ROUTINES_f "{OBSOLETE_ROUTINES_f} ¶{SRCDIR¶}{FILES}" Echo -n ¶t¶t '{SRCDIR}'{files}.o End End Echo Echo End >> pgplot.make Begin Set MAC_ROUTINES_f "" Quote -n MAC_ROUTINES = For files in {MAC_ROUTINES} Echo ' ¶' Echo -n ¶t¶t '{SYSDIR}'{files}.o Set MAC_ROUTINES_f "{MAC_ROUTINES_f} ¶{SYSDIR¶}{files}" End Echo Echo End >> pgplot.make #----------------------------------------------------------------------- # Target pgplot.lib is used to built the PGPLOT subroutine library. # pgplot.lib is the primary PGPLOT object library. #----------------------------------------------------------------------- Echo `Date -t` 'Writing pgplot.lib target.' Begin Echo "# ¶n¶ #----------------------------------------------------------------------- ¶n¶ # Rules for compiling the .o files ¶n¶ #----------------------------------------------------------------------- ¶n¶ #" Echo 'all ÄÄ pgplot.lib grfont.dat demos' Echo 'pgplot.lib ÄÄ {PG_ROUTINES} {PG_NON_STANDARD} {GR_ROUTINES} ¶' Echo 'grexec.f.o {DRIV_LIST} {SYSTEM_ROUTINES} {MAC_ROUTINES}' Echo ¶t 'Lib -f -mf {PG_ROUTINES} ¶' Echo ¶t¶t '{PG_NON_STANDARD} ¶' Echo ¶t¶t '{GR_ROUTINES} ¶' Echo ¶t¶t '{DRIV_LIST} ¶' Echo ¶t¶t '{SYSTEM_ROUTINES} ¶' Echo ¶t¶t '{MAC_ROUTINES} ¶' Echo ¶t¶t 'grexec.f.o -o pgplot.lib' End >> pgplot.make Echo `Date -t` 'Determining object file dependencies.' # List source code file dependencies explicitly. Echo `Date -t` 'Writing PG_ROUTINES dependencies' Begin For file in {PG_ROUTINES_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make Echo `Date -t` 'Writing PG_NON_STANDARD dependencies' Begin For file in {PG_NON_STANDARD_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make Echo `Date -t` 'Writing GR_ROUTINES dependencies' Begin For file in {GR_ROUTINES_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make Echo `Date -t` 'Writing SYSTEM_ROUTINES dependencies' Begin For file in {SYSTEM_ROUTINES_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make Echo `Date -t` 'Writing driv_list dependencies' Begin For file in {Driv_list_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End Echo grexec.f.o Ä grexec.f ¶n¶ ¶t '{FCOMPL} ' grexec.f ' {FFLAGC}' ¶n¶ grexec.f Ä drivers.list {SYSDIR}create_grexec.f ¶n¶ ¶t Directory '{SYSDIR}' ¶n¶ ¶t '{FCOMPL}' create_grexec.f '{FFLAGU}' ¶n¶ ¶t LinkFORTRANtool create_grexec create_grexec.f.o ¶n¶ ¶t Move -y create_grexec :: ¶n¶ ¶t Directory :: ¶n¶ ¶t create_grexec End >> pgplot.make Echo `Date -t` 'Writing MAC_ROUTINES dependencies' # Mac routines are always in {SYSDIR}, so don't need if structure Begin For file in {MAC_ROUTINES_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` Set dir `Echo -n {SYSDIR}{¨2}` End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make Echo `Date -t` 'Writing OBSOLETE_ROUTINES dependencies' Begin Echo 'pgplotold.lib ÄÄ {OBSOLETE_ROUTINES}' Echo ¶t Lib -f -mf ' {OBSOLETE_ROUTINES} -o pgplotold.lib' End >> pgplot.make Begin For file in {OBSOLETE_ROUTINES_f} If `evaluate "{file}" =~ '/{(Å)¨1}(Å)¨2/'` if {¨1} == SRCDIR Set dir `Echo -n {SRCDIR}{¨2}` Else If {¨1} == DEMDIR Set dir `Echo -n {DEMDIR}{¨2}` Else If {¨1} == FNTDIR Set dir `Echo -n {FNTDIR}{¨2}` Else If {¨1} == DRVDIR Set dir `Echo -n {DRVDIR}{¨2}` Else If {¨1} == GENDIR Set dir `Echo -n {GENDIR}{¨2}` Else If {¨1} == SYSDIR Set dir `Echo -n {SYSDIR}{¨2}` End End Echo -n {file}.o Ä {file}; ¶ search -sf -i -q /includeÅ'grpckg1.inc'/ "{dir}" > Dev:Null && Echo -n " grpckg1.inc"; ¶ search -sf -i -q /includeÅ'pgplot.inc'/ "{dir}" > Dev:Null && Echo -n " pgplot.inc" Echo ¶n¶t '{FCOMPL} ' {file} ' {FFLAGC}' End End >> pgplot.make #----------------------------------------------------------------------- # Target "demos" is used to make the demo programs. They can also be made # individually. #----------------------------------------------------------------------- Echo `Date -t` 'Writing Demos target' Begin Echo -n 'demos ÄÄ ' For file in {DEMOS} Echo -n '{DEMDIR}'"{file} " End Echo 'pgplot.lib' Echo ¶t 'Echo `Date -t` Creating demonstration programs.' For file in {DEMOS} Echo '{DEMDIR}'{file} Ä '{DEMDIR}'{file}.f.o pgplot.lib Echo ¶t '{FLINK}' '{DEMDIR}'{file} '{DEMDIR}'{file}.f.o pgplot.lib Echo ¶t AddResourceFile '{DEMDIR}'{file} If {file} == "pgdemo3" Echo ¶t '{SizRes}' '{DEMDIR}'{file} 1024 Else Echo ¶t '{SizRes}' '{DEMDIR}'{file} 512 End End For file in {DEMOS} Echo '{DEMDIR}'{file}.f.o Ä '{DEMDIR}'{file}.f Echo ¶t '{FCOMPL} {DEMDIR}'{file}.f ' {FFLAGD}' End End >> pgplot.make #----------------------------------------------------------------------- # Target "grfont.dat" is the binary font file. # This is created from grfont.txt with the "pgpack" program. # (a) compile the `pgpack' program; then # (b) run `pgpack' to convert the ASCII version of the font file # (grfont.txt) into the binary version (grfont.dat). When executed, # `pgpack' should report: # Characters defined: 996 # Array cells used: 26732 #----------------------------------------------------------------------- Echo `Date -t` 'Writing grfont.dat target.' Begin Echo grfont.dat ÄÄ '{FNTDIR}grfont.txt {SYSDIR}pgpack.f' ¶n¶ ¶t Duplicate -y '{SYSDIR}pgpack.f {FNTDIR}' ¶n¶ ¶t Directory '{FNTDIR}' ¶n¶ ¶t If grfont.dat == '`Exists -f grfont.dat`' ¶n¶ ¶t¶t Delete grfont.dat ¶n¶ ¶t End ¶n¶ ¶t FORTRAN pgpack.f '{FFLAGU}' ¶n¶ ¶t LinkFORTRANtool pgpack pgpack.f.o ¶n¶ ¶t 'Echo `Date -t` Executing pgpack, which takes a while and the ball does not spin. ¶n¶'¶n¶ ¶t 'Should report: ¶n¶'¶n¶ ¶t 'Characters defined: 996 ¶n¶'¶n¶ ¶t 'Array cells used: 26732' ¶n¶ ¶t pgpack ¶n¶ ¶t 'Echo `Date -t` Finished creating grfont.dat.' ¶n¶ ¶t Directory :: End >> pgplot.make Echo `Date -t` 'Writing pgplot.doc target.' Begin Echo pgplot.doc ÄÄ {SYSDIR}create_doc.f ¶n¶ ¶t Directory '{SYSDIR}' ¶n¶ ¶t '{FCOMPL}' create_doc.f '{FFLAGU}' ¶n¶ ¶t LinkFORTRANtool create_doc create_doc.f.o ¶n¶ ¶t Move -y create_doc :: ¶n¶ ¶t Directory :: ¶n¶ ¶t 'Echo `Date -t` Executing create_doc, which takes a long time and the ball does not spin.' Echo -n ¶t create_doc '{SRCDIR}' For files in {PG_ROUTINES} Echo ' ¶' Echo -n ¶t¶t {files} End Echo Echo ¶t 'Echo `Date -t` Finished creating pgplot.html and pgplot.doc.' End >> pgplot.make Echo `Date -t` 'Writing clean target.' Begin Echo clean ÄÄ ¶n¶ ¶t Delete -i '{PG_ROUTINES} ¶'¶n¶ ¶t '{PG_NON_STANDARD} ¶'¶n¶ ¶t '{GR_ROUTINES} ¶'¶n¶ ¶t grexec.f.o '{DRIV_LIST} ¶'¶n¶ ¶t '{SYSTEM_ROUTINES} ¶'¶n¶ ¶t '{MAC_ROUTINES}' End >> pgplot.make Echo `Date -t` 'Finished.' DIR}{files} == `Exists -f {SYSDIR}{files}` Set OBSOLETE_ROUTINES_f "{OBSOLETEpgplot/sys_mac/mcdriv.f010064400040640000322000000410060606631255100156300ustar00tjpcitmbr00000400000017!!G Toolbox.finc C If you have a power mac version of LS fortran uncomment the C next 5 lines and comment out "!!MP InLines.f" C!!IFC NOT LSPOWERF C!!MP 68KInlines C!!ELSEC C!!MP PPCInlines C!!ENDC C If you have a 68K mac version of LS fortran comment out the C 5 lines above and uncomment the next line. !!MP InLines.f SUBROUTINE MCDRIV (OPCODE, RBUF, NBUF, CHR, LCHR) Implicit None INTEGER OPCODE, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Macintosh computers. C C----------------------------------------------------------------------- C !!SETC USINGINCLUDES = .FALSE. include 'globals.f' c Bounding rectangle for the window record /rect/ bounds, rectangle record /WindowPtr/ myWindow RECORD /Point/ MouseLoc !Where it was clicked RECORD /KeyMap/ KeysTyped !What was typed. RECORD /PolyHandle/ Polyhnd !handle for a polygon region Record /PicHandle/ windowPic !handle for picture string*255 title,text logical*2 visible,goAway, Update, Ignore integer*4 minus1,Lw,ndum,npolypts,countpoly,windhgt,I,J,ColArr(0:7) Integer*2 xpt,ypt parameter (minus1 = -1, visible = .true., goAway = .false., + Update = .True.) Character*120 MSG,ch*1,Picture*3 Character*(*) MCTYPE Parameter (MCTYPE = 'MAC (Macintosh Window)') Data ColArr/WhiteColor,BlackColor,RedColor,GreenColor,BlueColor, + CyanColor,MagentaColor,YellowColor/ C Variables to handle event record. RECORD /EventRecord/ theEvent LOGICAL*2 DONE LOGICAL*1 AN_EVENT INTEGER*2 EVENT_MASK Save bounds, Mywindow, polyhnd, lw, npolypts, countpoly, + Windhgt,xpt, ypt, Ignore, QDG, ColArr, windowPic, Picture GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,900,200, 2 210,220,230,240,900,260,900,900,900), OPCODE GOTO 900 C C--- OPCODE = 1, Return device name.------------------------------------- C 10 CHR = MCTYPE LCHR = LEN(MCTYPE) C Get the global values now since this is needed later on and opcode=1 C is always called before the globals are needed. QDG = JQDGLOBALS() RETURN C C--- OPCODE = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C c Set up the bounding rectangle for the window that is the largest c that will fit on the screen. C Note that the bottom left hand corner is 0,0 in pgplot, while the C top left hand corner is 0,0 on a Mac. Leave about 40 pixels for the title C bar of the window. See OPCODE = 9 for how we translate the y coordinate. 20 RBUF(1) = 0.0 RBUF(2) = float(QDG^.screenbits.bounds.right) RBUF(3) = 0.0 RBUF(4) = float(QDG^.screenbits.bounds.bottom - 40) RBUF(5) = 0.0 RBUF(6) = 7.0 NBUF = 6 RETURN C C--- OPCODE = 3, Return device resolution. ------------------------------ C 30 RBUF(1) = 72.0 RBUF(2) = 72.0 RBUF(3) = 1.0 NBUF = 3 RETURN C C--- OPCODE = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor Control, No Hardware dashed lines, C Arbitary Polygons Fills, Pen Thickness support but ends are not C rounded, Rectangle Fills, Pixel Primitives Support, No Extra Prompt C before closing window, No color query support, No hardware symbol C support yet. C 40 CONTINUE CHR = 'ICNATRPNNN' RETURN C C--- OPCODE = 5, Return default name. ------------------------------ C 50 CHR = 'PGPLOT Mac Window' LCHR = LEN(MCTYPE) RETURN C C--- OPCODE = 6, Return default physical size of plot. ------------------ C 60 RBUF(1) = 0.0 RBUF(2) = float(QDG^.screenbits.bounds.right) RBUF(3) = 0.0 RBUF(4) = float(QDG^.screenbits.bounds.bottom - 40) NBUF = 4 RETURN C C--- OPCODE = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1 NBUF = 1 RETURN C C--- OPCODE = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- OPCODE = 9, Open workstation. -------------------------------------- C 90 NBUF = 2 C If the size of the window has not been set than set it to the C default window size. If ((bounds.right .eq. 0) .or. (bounds.bottom .eq. 0)) Then bounds = QDG^.screenbits.bounds bounds.top = QDG^.screenbits.bounds.top + 40 bounds.bottom = QDG^.screenbits.bounds.bottom End If windhgt = bounds.bottom - bounds.top C Ignore RBUF(3) for now. I'm not sure what it is used for. c Call NewWindow with nil to create the window on the heap title = chr(:lchr) myWindow.P = NewWindow(nil,bounds,%ref(title), 1 visible,int2(noGrowDocProc),minus1, 2 goAway,nil) If (myWindow.P .EQ. 0) then RBUF(1) = 0.0 RBUF(2) = 0.0 Else Call Setport(myWindow.p) RBUF(1) = float(myWindow.P) RBUF(2) = 1.0 End If RETURN C C--- OPCODE=10, Close workstation. -------------------------------------- C 100 CONTINUE Call DisposeWindow(myWindow.P) RETURN C C--- OPCODE=11, Begin picture. ------------------------------------------ C 110 CONTINUE C Erase previous screen Call EraseRect(myWindow.P^.portRect) C Resize Window bounds.right = int2(nint(Rbuf(1))) bounds.bottom = int2(nint(rbuf(2))+40) windhgt = bounds.bottom - bounds.top Call SizeWindow(myWindow.P,bounds.right,bounds.bottom,Update) If (MyWindow.p .eq. NiL) Then WRITE (MSG,'(''Could not resize window: '',I10)') OPCODE CALL GRWARN(MSG) Ignore = .TRUE. End If C Set the origin of the window to the lower, left hand corner to correspond C with PGPLOT. Note that the y-coordinate increases downward on a mac C while it increases upward in PGPLOT. So after setting the origin to C the bottom left hand corner, y-coordinate on mac equals the negative of the C y-coordinate from PGPLOT. call ClipRect(myWindow.P^.portRect) Call SetOrigin(int2(0),int2(0)) Call grgenv('MACPICTURE',Picture,ndum) If (picture(1:2) .eq. 'ON') Then C Open picture to record quick draw calls. C Write(0,*) 'Opening Picture' rectangle.top = 0 rectangle.bottom = windhgt rectangle.left = 0 rectangle.right = bounds.right windowPic = OpenPicture(rectangle) call ClipRect(rectangle) Call ShowPen() End If C Initialize constants. Ignore = .False. npolypts = 0 Countpoly = 0 RETURN C C--- OPCODE=12, Draw line. ---------------------------------------------- C 120 CONTINUE If (Ignore) Return Call MoveTo(int2(nint(Rbuf(1))),int2(windhgt-nint(Rbuf(2)))) Call LineTo(int2(nint(Rbuf(3))),int2(windhgt-nint(Rbuf(4)))) Return C C--- OPCODE=13, Draw dot. ----------------------------------------------- C 130 CONTINUE If (Ignore) Return xpt = Nint(rbuf(1)) ypt = windhgt-Nint(rbuf(2)) ndum = Nint(float(LW)/2.) If (ndum .gt. 0) Then rectangle.left = int2(xpt-ndum) rectangle.right = int2(xpt + ndum) rectangle.top = int2(ypt-ndum) rectangle.bottom = int2(ypt+ndum) Call PaintOval(Rectangle) Else Call MoveTo(int2(xpt),int2(ypt)) Call LineTo(int2(xpt),int2(ypt)) End If Return C C--- OPCODE=14, End picture. -------------------------------------------- C 140 CONTINUE If (Ignore) Return If (Picture(1:2) .eq. 'ON') Then Call ClosePicture() C Write(0,*)'Picture size = ',gethandlesize(windowpic) Call HidePen() Call Setport(mywindow.p) Call SetWindowPic(myWindow.P,windowpic) End If call GetWTitle(myWindow.P,%ref(text)) ! save window title title = 'Type return to continue. Command . to quit program' Call SetWTitle(myWindow.p,title) ! put up new instructions. EVENT_MASK = $FFFF !ALL EVENTS DONE = .false. DO WHILE (DONE = .false.) AN_EVENT = GetNextEvent(EVENT_MASK,%REF(theEvent)) IF (AN_EVENT) CALL EVENTHANDLER(theEvent,DONE,ch,MouseLoc,opcode) END DO Call SetWTitle(myWindow.p,text) ! Restore original title If (Rbuf(1) .ne. 0.0) Call EraseRect(myWindow.P^.portRect) Call KillPicture(Windowpic) RETURN C C--- OPCODE=15, Select color index. ------------------------------------- C 150 CONTINUE Call ForeColor(ColArr(Nint(rbuf(1)))) Return C C--- OPCODE=16, Flush Buffer. -------------------------------------------- C Ignore 160 Continue Return C C--- OPCODE=17, Read cursor. -------------------------------------------- C 170 Continue If (Ignore) Return call GetWTitle(myWindow.P,%ref(text)) ! save window title title = 'Type any character or use mouse. Command . to quit program' Call SetWTitle(myWindow.p,title) ! put up new instructions. EVENT_MASK = $FFFF !ALL EVENTS DONE = .false. DO WHILE (DONE = .false.) AN_EVENT = GetNextEvent(EVENT_MASK,%REF(theEvent)) IF (AN_EVENT) CALL EVENTHANDLER(theEvent,DONE,ch,MouseLoc,opcode) END DO chr(1:1) = ch Rbuf(1) = float(MouseLoc.h) Rbuf(2) = float(windhgt-MouseLoc.v) NBuf = 2 Call SetWTitle(myWindow.p,text) ! Restore original title Return C C--- OPCODE=18, Erase alpha screen. ------------------------------------- C (Null operation: there is no alpha screen.) C 180 CONTINUE RETURN C C--- OPCODE=20, Polygon fill. ------------------------------------------- C 200 CONTINUE If (Ignore) Then Return else If (Npolypts .ne. 0) Then Countpoly = Countpoly + 1 If (CountPoly .eq. 1) Then xpt = int2(Nint(Rbuf(1))) ypt = Int2(Nint(Windhgt-Rbuf(2))) Call MoveTo(xpt,ypt) Else If (CountPoly .lt. Npolypts) Then Call LineTo(int2(Nint(Rbuf(1))),Int2(Nint(Windhgt-Rbuf(2)))) Else Call LineTo(int2(Nint(Rbuf(1))),Int2(Nint(Windhgt-Rbuf(2)))) Call LineTo(xpt,ypt) Call ClosePoly() Call PaintPoly(Polyhnd) Call KillPoly(PolyHnd) Npolypts = 0 CountPoly = 0 End If Else Npolypts = Nint(Rbuf(1)) Polyhnd = OpenPoly() End If Return C C--- OPCODE=21, Set color representation. ------------------------------- C 210 CONTINUE RETURN C C--- OPCODE=22, Set line width. ----------------------------------------- C 220 CONTINUE LW = NINT(max(RBUF(1)/2.,1.)) Call PenSize(Int2(Lw),int2(Lw)) Return C C--- OPCODE=23, Escape. ------------------------------------------------- C C The text in char is drawn directly on the screen at the current location C and font. 230 CONTINUE If (ignore) Return text = chr(:LCHR) Call DrawString(text) RETURN C C--- OPCODE=24, Rectangle fill. ------------------------------------------- C 240 CONTINUE If (ignore) Return rectangle.left = int2(nint(rbuf(1))) Rectangle.right = int2(nint(rbuf(3))) Rectangle.top = int2(Windhgt-nint(rbuf(4))) Rectangle.bottom = int2(Windhgt-nint(rbuf(2))) Call PaintRect(Rectangle) Return C C--- OPCODE=26, Image.--------------------------------------------------- C 260 CONTINUE If (ignore) Return xpt = Nint(Rbuf(1)) ypt = Windhgt - Nint(Rbuf(2)) Call MoveTo(Int2(xpt),Int2(ypt)) Call ForeColor(Colarr(Nint(Rbuf(3)))) Do I = 4, Nbuf If (Rbuf(I) .ne. Rbuf(I-1)) Then Call LineTo(int2(Nint(Rbuf(I-1))),int2(ypt)) Call ForeColor(Colarr(Nint(Rbuf(I)))) Call MoveTo(Int2(Nint(Rbuf(I))),int2(ypt)) End If End Do Call LineTo(Int2(Nint(Rbuf(I))),int2(ypt)) Return C----------------------------------------------------------------------- C Error: unimplemented function. C 900 WRITE (MSG, 1 '(''Unimplemented function in MC device driver: '',I10)') OPCODE CALL GRWARN(MSG) NBUF = -1 RETURN End SUBROUTINE EVENTHANDLER(theEvent,DONE,ch,MouseLoc,opcode) c This routines figures out what kind of event has occurred and c calls the appropriate routine to take action in response to the event. c It returns DONE as true when it is finished. implicit none !!SETC USINGINCLUDES = .FALSE. include 'globals.f' RECORD /EventRecord/ theEvent RECORD /WindowPtr/ P, OLDPORT, CLWIN RECORD /Rect/ LIMITRECT RECORD /Point/ MouseLoc !Where it was clicked LOGICAL*2 DONE LOGICAL*1 CLOSEIT INTEGER*2 WindowPart CHARACTER*1 CH INTEGER*4 OUTPUTWINDOW,opcode EXTERNAL OUTPUTWINDOW !Routine to identify the default window QDG = JQDGLOBALS() DONE = .false. Select Case (theEvent.what) Case (mouseDown) WindowPart = FindWindow(theEvent.where,%REF(P)) Select Case (WindowPart) Case (inMenuBar) !MENUBAR C CALL DO_MENU(MenuSelect(theEvent.where),DONE) Case (inSysWindow) !in Sys window Call SystemClick(theEvent,P) Case (inContent) !CONTENT Region IF (P.P .NE. FrontWindow) Then CALL SelectWindow(P.P) Else If (Opcode .eq. 17) Then Call GetMouse(%ref(MouseLoc)) If (JIAND(theEvent. modifiers,OptionKey) .eq. 2048) Then If (JIAND(theEvent. modifiers,ShiftKey) .eq. 512) Then ch = 'X' ! option-shift click means send X Else ch = 'D' ! option click means send D End If Else ch = 'A' ! click means send A End If Done = .True. End If End If Case (inDrag) !DRAG Region IF (P.P .NE. FrontWindow) Then CALL SelectWindow(P.P) else LIMITRECT = QDG^.screenBits.bounds Call InsetRect(LimitRect,int2(4),int2(4)) CALL DragWindow(P,theEvent.where,LIMITRECT) End if Case (inGrow) !SIZE Region Case (inGoAway) !close box C IF (P.P .NE. OUTPUTWINDOW()) THEN C CLOSEIT = TrackGoAway(P,theEvent.where) C IF (CLOSEIT) CALL CLOSE_A_WINDOW(P) C End if Case Default ! No other window parts to deal with. End Select ! End of mouseDown Event. Case (mouseUp) !MOUSE UP This program does nothing in response to this event. Case ( keyDown) !key PRESS CH = char(JIAND(theEvent.message,charCodeMask)) If ((JIAND(theEvent. modifiers,cmdKey) .eq. 256) .and. (ch .eq. '.')) then Stop 'Program stopped by command-.' End If if (Opcode .eq. 17) Then Call GetMouse(%ref(MouseLoc)) Done = .True. Else If (ch .eq. char(13)) Then Done = .True. End If Case (keyUp) !This program does nothing in response to this event. Case (autoKey) !This program does nothing in response to this event. Case (updateEvt) CALL REDRAW_WIN(theEvent.message) ! Redraw window connect to start 5 and 6 Case (diskEvt) !This program does nothing in response to this event. Case (activateEvt) C CALL SetPort(theEvent.message) C CALL DrawGrowIcon(theEvent.message) Case Default End Select RETURN ENTRY REDRAW_WIN(CLWIN) CALL GetPort(%REF(OLDPORT)) !Remember current port CALL SetPort(CLWIN) CALL BeginUpdate(CLWIN) IF (CLWIN.P .EQ. OUTPUTWINDOW()) THEN CALL F_DRAWOUTPWINDOW CALL DrawControls(CLWIN) END IF CALL DrawGrowIcon(CLWIN) CALL EndUpdate(CLWIN) CALL SetPort(OLDPORT) 10 RETURN END NTS DONE = .false. DO WHILE (DONE = .false.) AN_EVENT = GetNextEvent(EVENT_MASK,%REF(theEvent)) IF (AN_EVENT) CALL EVENTHANDLER(theEvent,DONE,ch,MouseLoc,opcode) END DO Call SetWTitle(myWindow.p,text) ! Restore original title If (Rbuf(1) .ne. 0.0) Call EraseRect(myWindow.P^.portRect) Call KillPicture(Windowpic) RETURN C C--- OPCODE=15, Select color index. ------------------------------------- C 150 CONTINUE Call ForeColor(Colpgplot/sys_mac/mfdriv.f010064400040640000322000000531720563041570600156440ustar00tjpcitmbr00000400000017C*MFDRIV -- PGPLOT Graphics MetaFile driver C+ SUBROUTINE MFDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C C PGPLOT driver for Graphics MetaFile device. C C Version 1.0 - 1989 May 09 - S. C. Allendorf C First attempt at recreating the old C MetaFile device. Code based on original C version written by Tim Pearson. C Version 1.1 - 1989 May 20 - S. C. Allendorf C Make driver conform as closely as possible C to the standard without breaking GMFPLOT C and/or PGPLOT. Deviations from the C standard are marked with C *** DEVIATION ***. GMFPLOT and/or PGPLOT C would need to be changed to correct these C parts. C======================================================================= C C Supported device: The MetaFile device can be used to a store graphic C image in a device-independent disk file. C C Device type code: /FILE. C C Default device name: PGPLOT.GMF. C C Default view surface dimensions: Undefined (nominally 8 inches C square). C C Resolution: Undefined. C C Color capability: Color indices 0-255 are accepted and the C representation of all colors may be changed. The actual colors used C depend upon the output device chosen when the file is rendered. C C Input capability: None. C C File format: The metafile generated follow the "GSPC Metafile C Proposal" described in Computer Graphics (A.C.M.), Volume 13, number 3 C (August 1979). C C Obtaining hardcopy: Use the translator program GMFPLOT. C----------------------------------------------------------------------- LOGICAL CONT INTEGER*2 BUFFER(360), COMBUF(5), I0, I1, IB, IC, IG, IR, J0, J1 INTEGER*2 LASTI, LASTJ, NPICT, NPTS INTEGER*4 HW, IER, LUN, REMCAL REAL*4 RATIO, SCALE, XMAX, YMAX CHARACTER MSG*10 CHARACTER*(*) DEFNAM, TYPE PARAMETER (DEFNAM = 'PGPLOT.GMF') PARAMETER (TYPE = 'FILE (PGPLOT graphics metafile)') C----------------------------------------------------------------------- C Branch on opcode. GOTO ( 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 1 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 2 210, 220, 230, 240, 250, 260), IFUNC C Signal an error. 900 WRITE (MSG, '(I10)') IFUNC CALL GRWARN ('Unimplemented function in MetaFile device driver:' 1 // MSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name ------------------------------------- C 10 CONTINUE CHR = TYPE NBUF = 0 LCHR = LEN(TYPE) RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices --------------------------------------- C 20 CONTINUE RBUF(1) = 0.0 RBUF(2) = 32767.0 RBUF(3) = 0.0 RBUF(4) = 32767.0 RBUF(5) = 0.0 RBUF(6) = 255.0 NBUF = 6 LCHR = 0 RETURN C C--- IFUNC = 3, Return device resolution ------------------------------- C 30 CONTINUE RBUF(1) = 4096.0 RBUF(2) = 4096.0 RBUF(3) = 1.0 NBUF = 3 LCHR = 0 RETURN C C--- IFUNC = 4, Return misc device info -------------------------------- C (This device is Hardcopy, No cursor, Dashed lines, Area fill, C Thick lines, Rectangle fill, No line of pixels) C 40 CONTINUE CHR = 'HNDATRNNNN' NBUF = 0 LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name ------------------------------- C 50 CONTINUE CHR = DEFNAM NBUF = 0 LCHR = LEN (DEFNAM) RETURN C C--- IFUNC = 6, Return default physical size of plot ------------------- C 60 CONTINUE RBUF(1) = 0.0 RBUF(2) = 32767.0 RBUF(3) = 0.0 RBUF(4) = 32767.0 NBUF = 4 LCHR = 0 RETURN C C--- IFUNC = 7, Return misc defaults ----------------------------------- C 70 CONTINUE RBUF(1) = 20.0 NBUF = 1 LCHR = 0 RETURN C C--- IFUNC = 8, Select plot -------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation --------------------------------------- C 90 CONTINUE C Assume success. RBUF(2) = 1.0 C Obtain a logical unit number. CALL GRGLUN (LUN) C Check for an error. IF (LUN .EQ. -1) THEN CALL GRWARN ('Cannot allocate a logical unit.') RBUF(2) = 0.0 RETURN ELSE RBUF(1) = LUN END IF C Open the output file. OPEN (UNIT = LUN, FILE = CHR(:LCHR), CARRIAGECONTROL = 'NONE', 1 DEFAULTFILE = DEFNAM, DISPOSE = 'DELETE', STATUS = 'NEW', 2 RECL = 180, FORM = 'UNFORMATTED', RECORDTYPE = 'FIXED', 3 IOSTAT = IER) C Check for an error and cleanup if C one occurred. IF (IER .NE. 0) THEN CALL GRWARN ('Cannot open output file for MetaFile plot: ' // 1 CHR(:LCHR)) CALL GRFLUN (LUN) RBUF(2) = 0 RETURN ELSE C Get the full file specification C and calculate the length of the C string INQUIRE (UNIT = LUN, NAME = CHR) LCHR = LEN (CHR) 95 IF (CHR (LCHR:LCHR) .EQ. ' ') THEN LCHR = LCHR - 1 GOTO 95 END IF END IF C Initialize the page counter. NPICT = 0 C Initialize the high water mark. HW = 0 C Send the BEGIN_METAFILE command, C requesting 15-bit precision. COMBUF(1) = '8001'X COMBUF(2) = '0001'X CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 10, Close workstation ------------------------------------- C 100 CONTINUE C Send the END_METAFILE command. CALL GRMF01 (1, '8100'X, BUFFER, LUN, HW) C Flush the buffer. CALL GRMF02 (LUN, HW, BUFFER) C Close the file. CLOSE (LUN, DISPOSE = 'KEEP') C Deallocate the logical unit. CALL GRFLUN (LUN) C RETURN C C--- IFUNC = 11, Begin picture ----------------------------------------- C 110 CONTINUE C Increment the page number. NPICT = NPICT + 1 C *** DEVIATION *** C The MetaFile standard defines C the initial pen position to be at C (0, 0). This causes problems for C PGPLOT. C C Set the last position to unknown. LASTI = -1 LASTJ = -1 C Check to see if this is the first C picture. IF (NPICT .EQ. 1) THEN C Initialize the requested size and C and scale factor. XMAX = INT (RBUF(1) + 0.5) YMAX = INT (RBUF(2) + 0.5) SCALE = 1.0 C See if the user has requested a C specific size. IF (XMAX .NE. 32767.0 .OR. YMAX .NE. 32767.0) THEN C Calculate the the maximum C coordinates and the scale factor. COMBUF(2) = 32767 COMBUF(3) = 32767 RATIO = (YMAX + 1.0) / (XMAX + 1.0) IF (RATIO .LT. 1.0) THEN SCALE = 32767.0 / XMAX XMAX = 32767.0 YMAX = INT (32768.0 * RATIO - 0.5) COMBUF(3) = YMAX ELSE IF (RATIO .GT. 1.0) THEN SCALE = 32767.0 / YMAX XMAX = INT (32768.0 / RATIO - 0.5) YMAX = 32767.0 COMBUF(2) = XMAX ELSE SCALE = 32767.0 / XMAX XMAX = 32767.0 YMAX = 32767.0 END IF C Send DEFINE_NDC_SPACE command C along with X, Y, and Z ranges if C the user hasn't requested a C square plot. IF (RATIO .NE. 1.0) THEN COMBUF(1) = '8203'X COMBUF(4) = 0 CALL GRMF01 (4, COMBUF, BUFFER, LUN, HW) END IF END IF END IF C Flush buffer to get to a record C boundary. CALL GRMF02 (LUN, HW, BUFFER) C Send BEGIN_PICTURE command with C the picture number. COMBUF(1) = '9001'X COMBUF(2) = NPICT CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 12, Draw line --------------------------------------------- C 120 CONTINUE C Scale and convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) I1 = INT (MIN (RBUF(3) * SCALE + 0.5, XMAX)) J1 = INT (MIN (RBUF(4) * SCALE + 0.5, YMAX)) C See if this is a continuation. CONT = (LASTI .EQ. I0) .AND. (LASTJ .EQ. J0) C Draw the line. CALL GRMF00 (I0, J0, I1, J1, CONT, BUFFER, LUN, HW) C Update the last position LASTI = I1 LASTJ = J1 RETURN C C--- IFUNC = 13, Draw dot ---------------------------------------------- C 130 CONTINUE C Convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) C Draw the dot. CALL GRMF00 (I0, J0, I0, J0, .FALSE., BUFFER, LUN ,HW) C Update the last position. LASTI = I0 LASTJ = J0 RETURN C C--- IFUNC = 14, End picture ------------------------------------------- C 140 CONTINUE C Send a END_PICTURE command. CALL GRMF01 (1, '9100'X, BUFFER, LUN, HW) RETURN C C--- IFUNC = 15, Select color index ------------------------------------ C 150 CONTINUE C Save the requested color index. IC = RBUF(1) C *** DEVIATION *** C The MetaFile standard defines C indices 0-7 and they are C different than those defined by C PGPLOT. C C Send the SET_COLOR command along C with the color index. COMBUF(1) = 'C101'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 16, Flush buffer. ----------------------------------------- C (Not implemented: ignored.) C 160 CONTINUE RETURN C C--- IFUNC = 17, Read cursor. ------------------------------------------ C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C 190 CONTINUE C Convert to an integer. IC = RBUF(1) C Send SET_LINESTYLE command along C width the requested linestyle. COMBUF(1) = 'C301'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 20, Polygon fill. ----------------------------------------- C 200 CONTINUE IF (REMCAL .EQ. 0) THEN C First time, send DRAW_POLYGON and C the number of points. NPTS = RBUF(1) REMCAL = NPTS COMBUF(1) = 'A701'X COMBUF(2) = NPTS CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) ELSE C Second and succeeding calls, C MOVE to first point, DRAW to the C rest, and decrement the counter. COMBUF(1) = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) COMBUF(2) = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) IF (REMCAL .NE. NPTS) COMBUF(2) = IBSET (COMBUF(2), 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) REMCAL = REMCAL - 1 C *** DEVIATION *** C The MetaFile standard defines C the pen position after a polygon C draw to be at the first point. C This causes problems for PGPLOT. C C Set the pen position to unknown. IF (REMCAL .EQ. 0) LASTI = -1 END IF RETURN C C--- IFUNC = 21, Set color representation. ----------------------------- C 210 CONTINUE C *** DEVIATION *** C The MetaFile standard defines C indices 0-7 and does not allow C them to be changed. C C Convert input to integer IC = RBUF(1) IR = INT (MIN (32767.0, MAX (RBUF(2) * 32767.0, 0.0))) IG = INT (MIN (32767.0, MAX (RBUF(3) * 32767.0, 0.0))) IB = INT (MIN (32767.0, MAX (RBUF(4) * 32767.0, 0.0))) C Send DEFINE_COLOR_INDEX command C along with the index to be C defined and its definition. COMBUF(1) = 'C004'X COMBUF(2) = IC COMBUF(3) = IR COMBUF(4) = IG COMBUF(5) = IB CALL GRMF01 (5, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 22, Set line width. --------------------------------------- C 220 CONTINUE C *** DEVIATION *** C The MetaFile standard defines C linewidths differently than C PGPLOT. C C Convert to an integer. IC = RBUF(1) C Send SET_LINEWIDTH command along C with the requested line width. COMBUF(1) = 'C401'X COMBUF(2) = IC CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) RETURN C C--- IFUNC = 23, Escape ------------------------------------------------ C (Not implemented: ignored.) C 230 CONTINUE RETURN C C--- IFUNC = 24, Rectangle fill. --------------------------------------- C 240 CONTINUE C Scale and convert to integer. I0 = INT (MIN (RBUF(1) * SCALE + 0.5, XMAX)) J0 = INT (MIN (RBUF(2) * SCALE + 0.5, YMAX)) I1 = INT (MIN (RBUF(3) * SCALE + 0.5, XMAX)) J1 = INT (MIN (RBUF(4) * SCALE + 0.5, YMAX)) C Simulate a hardware area fill. COMBUF(1) = 'A701'X COMBUF(2) = 4 CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I0 COMBUF(2) = J0 CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I1 COMBUF(2) = IBSET (J0, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I1 COMBUF(2) = IBSET (J1, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) COMBUF(1) = I0 COMBUF(2) = IBSET (J1, 15) CALL GRMF01 (2, COMBUF, BUFFER, LUN, HW) C *** DEVIATION *** C The MetaFile standard defines C the pen position after a polygon C draw to be at the first point. C This causes problems for PGPLOT. C C Set the pen position to unknown. LASTI = -1 RETURN C C--- IFUNC = 25, ------------------------------------------------------- C (Not implemented: should not be called.) C 250 CONTINUE GOTO 900 C C--- IFUNC = 26, Line of pixels. --------------------------------------- C (Not implemented: should not be called.) C 260 CONTINUE GOTO 900 C----------------------------------------------------------------------- END C*GRMF00 -- PGPLOT MetaFile driver, draw a line segment C+ SUBROUTINE GRMF00 (I0, J0, I1, J1, CONT, BUFFER, LUN, HW) LOGICAL CONT INTEGER*2 BUFFER(360), I0, I1, J0, J1 INTEGER*4 HW, LUN C----------------------------------------------------------------------- C Draw a line. This requires a MOVE command (unless the starting point C is the same point as the end point of the last line) followed by a C DRAW command. C C Arguments: C C I0, J0 (input) The absolute device coordinates of the C starting point of the line C I1, J1 (input) The absolute device coordinates of the ending C point of the line C CONT (input) Flag denoting whether the line is a C continuation C BUFFER (input/output) The buffer C----------------------------------------------------------------------- INTEGER*2 OUTPUT(4) INTEGER*4 K C----------------------------------------------------------------------- C Initialize the counter. K = 0 C See if we need to MOVE first. IF (.NOT. CONT) THEN C Increment the counter. K = 2 C Output the coordinates. OUTPUT(1) = I0 OUTPUT(2) = J0 END IF C Send the x coordinate. OUTPUT(K + 1) = I1 C Mark the y coordinate as a DRAW C command and output it. OUTPUT(K + 2) = IBSET (J1, 15) C Increment the counter. K = K + 2 C Transfer the coordinates to the C buffer. CALL GRMF01 (K, OUTPUT, BUFFER, LUN, HW) C----------------------------------------------------------------------- RETURN END C*GRMF01 -- PGPLOT MetaFile driver, transfer chunks to output buffer C+ SUBROUTINE GRMF01 (N, CHUNKS, BUFFER, LUN, HW) INTEGER*4 HW, LUN, N INTEGER*2 CHUNKS(N), BUFFER(360) C C Transfer metafile chunks to output buffer. If the command would C overflow, it is flushed to the output device using routine GRMF02. C C Arguments: C C N (input) The number of chunks to transfer C CHUNKS (input) The chunks to transfer C BUFFER (input/output) The buffer C LUN (input) Fortran unit number for output C HW (input/output) Number of elements used in BUFFER C----------------------------------------------------------------------- INTEGER*4 I C----------------------------------------------------------------------- C Flush the buffer if the command C would overflow it. IF (HW + N .GT. 360) CALL GRMF02 (LUN, HW, BUFFER) C Transfer the chunks to the C buffer. DO 10 I = 1, N C Increment the high water mark. HW = HW + 1 C Move the chunk to the buffer. BUFFER(HW) = CHUNKS(I) 10 CONTINUE C----------------------------------------------------------------------- RETURN END C*GRMF02 -- PGPLOT MetaFile driver, flush metafile buffer contents C+ SUBROUTINE GRMF02 (LUN, HW, BUFFER) INTEGER*2 BUFFER(360) INTEGER*4 HW, LUN C C Flush metafile buffer contents. If the buffer is not full, it is C padded with NO_OPERATION commands. C C Arguments: C C LUN (input) Fortran unit number for output C HW (input/output) Number of elements used in BUFFER C BUFFER (input/output) The buffer C----------------------------------------------------------------------- INTEGER*4 I C----------------------------------------------------------------------- C See if the buffer has anything in C it. IF (HW .GT. 0) THEN C Fill buffer with NO_OPERATION C commands. DO 10 I = HW + 1 ,360 BUFFER(I) = '8400'X 10 CONTINUE C Write out the buffer. WRITE (LUN) BUFFER C Reset the high water mark. HW = 0 END IF C----------------------------------------------------------------------- RETURN END --------------------------------------- C (Not implemented: should not be called.) C 170 CONTINUE GOTO 900 C C--- IFUNC = 18, Erase alpha screen. ----------------------------------- C (Not implemented: ignored.) C 180 CONTINUE RETURN C C--- IFUNC = 19, Set line style. --------------------------------------- C 190 CONTINUE C Conpgplot/sys_mac/newgrgenv.f010064400040640000322000000117030607724214000163450ustar00tjpcitmbr00000400000017C If you have a power mac version of LS fortran uncomment the C next 5 lines and comment out "!!MP InLines.f" C!!IFC NOT LSPOWERF C!!MP 68KInlines C!!ELSEC C!!MP PPCInlines C!!ENDC C If you have a 68K mac version of LS fortran comment out the C 5 lines above and uncomment the next line. !!MP InLines.f C*GRGENV -- get value of PGPLOT environment parameter (MAC) C+ SUBROUTINE GRGENV(NAME, VALUE, L) CHARACTER*(*) NAME, VALUE INTEGER L C C Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, C environment parameters are UNIX environment variables; e.g. parameter C ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not C recursive and is case-sensitive. C C Arguments: C NAME : (input) the name of the parameter to evaluate. C VALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C L : receives the number of characters in VALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C C On Macintosh, the environment variables are stored in file. This subroutine C first looks for the file PGPLOTENVNAMES, in the application directory. C If it can't be found, a standard file dialog box will be displayed, C so that you can find the file. Once it is found, the name and location are C stored so that you will not be prompted again. C-- C 19-Jan-1988 C 25-Sep-1995 Modified to work on mac with MPW Fortran 2.1. All environment C parameters are stored in the file. The file can have any name C but best thing to do is to put a file called pgplotenvnames C in the application directory. See Tech. Note 35 for more information C about Macintosh file system. C 17-Jan-1996 Modified by Mike Burnett (mnb@ornl.gov) to search for the C pgplotenvnames file in the preferences folder before putting C up dialog box. C----------------------------------------------------------------------- INTEGER LIN, LUN,LStart,VolRefNum, JVRefNum, myresult CHARACTER*32 TEST, Line*120, FilNam*120 INTEGER*4 myDirID External JVRefNum Save FileName,VolRefNum include 'Folders.f' C TEST = 'PGPLOT_'//NAME LIN = INDEX(TEST, ' ')-1 Value = ' ' L = 0 Call GrgLun(LUN) C If volume reference number has been set, switch to that volume. The C first time grgenv is called, volrefnum will not be set and the currect C directory is the application directory. The volume reference number will C be set after pgplotenvnames is found. If (VolRefNum .lt. 0) Then Call F_SETVOLUME(VolRefNum) End If C Try to open FilNam. The first time that Grgenv is called Filnam will C be empty and the open will fail. So try to open pgplotenvnames in the C current directory. If that fails put up a standard file dialog box to C find pgplotenvnames. If FilNam has been set then after assigning a C unit number to the file reset the volume reference number to the application C directory. Open(Unit = lun,File=FilNam,Status='OLD',Err = 10,Readonly) Call F_SETVOLUME(JVREFNUM(-1)) Go to 1 10 Open(Unit = lun,File='pgplotenvnames',Status='OLD',Err = 15,Readonly) FilNam = 'pgplotenvnames' VolRefNum = JVREFNUM(Lun) Go to 1 15 myresult = FindFolder(kOnSystemDisk,kPreferencesFolderType, & kDontCreateFolder,%REF (myVRefNum),%REF (myDirID)) if (myresult.ne.0) go to 20 myresult = HSetVol(NIL,myVRefNum,myDirID) if (myresult.ne.0) go to 20 Open(Unit=lun,File='pgplotenvnames',Status='OLD',Err=20,Readonly) FilNam = 'pgplotenvnames' VolRefNum = JVREFNUM(Lun) Call F_SETVOLUME(JVREFNUM(-1)) Go to 1 C Put up standard file dialog box. Once found store the file name and volume C reference number. 20 Call F_SETVOLUME(JVREFNUM(-1)) CALL GRWARN('Could not find file PGPLOTENVNAMES in current directory.') CALL GRWARN('A dialog box will come up allowing you to find the file with the') CALL GRWARN('environment variables. Hit return for the dialog box to appear.') Pause Open(Unit=lun,File=*,STATUS='OLD',err=100,Readonly) Inquire(Unit=LUN,Name=FilNam) VolRefNum = JVREFNUM(Lun) C File has been found, so search for environmental variable and extract value. 1 Continue Read(Lun,'(A512)',End=2) Line If (Test(:Lin) .EQ. Line(:Lin)) Then Lstart = index(Line,"'")+1 L = index(Line(Lstart:),"'")-1 Value = Line(LStart:LStart+L-1) Close(Lun) Go to 2 End If Go to 1 2 Close(LUN) Return C Could not find PGPLOTENVNAMES. 100 Close(LUN) CALL GRWARN('Cancelled dialog box to find PGPLOTENVNAMES') Return END pgplot/sys_mac/pgbeg.f010064400040640000322000000146050577734225100154450ustar00tjpcitmbr00000400000017C*PGBEG -- begin PGPLOT, open output device C%int cpgbeg(int unit, char *file, int nxsub, int nysub); C+ INTEGER FUNCTION PGBEG (UNIT, FILE, NXSUB, NYSUB) INTEGER UNIT CHARACTER*(*) FILE INTEGER NXSUB, NYSUB C C Begin PGPLOT, open the plot file. A call to PGBEG is C required before any other calls to PGPLOT subroutines. If a plot C file is already open for PGPLOT output, it is closed before the new C file is opened. C C Returns: C PGBEG : a status return value. A value of 1 indicates C successful completion, any other value indicates C an error. In the event of error a message is C written on the standard error unit. C To test the return value, call C PGBEG as a function, eg IER=PGBEG(...); note C that PGBEG must be declared INTEGER in the C calling program. C Arguments: C UNIT (input) : this argument is ignored by PGBEG (use zero). C FILE (input) : the "device specification" for the plot device. C Device specifications are installation dependent, C but usually have the form "device/type" or C "file/type". If this argument is a C question mark ('?'), PGBEG will prompt the user C to supply a string. If the argument is a blank C string (' '), PGBEG will use the value of C environment variable PGPLOT_DEV. C NXSUB (input) : the number of subdivisions of the view surface in C X (>0 or <0). C NYSUB (input) : the number of subdivisions of the view surface in C Y (>0). C PGPLOT puts NXSUB x NYSUB graphs on each plot C page or screen; when the view surface is sub- C divided in this way, PGPAGE moves to the next C panel, not the next physical page. If C NXSUB > 0, PGPLOT uses the panels in row C order; if <0, PGPLOT uses them in column order. C-- C 1-Jan-1984 [TJP] C 8-Aug-1985 [TJP] - add '?' prompting. C 31-Dec-1985 [TJP] - fix '?' prompting in batch jobs. C 11-Sep-1986 [TJP] - add PGLDEV call. C 9-Feb-1988 [TJP] - replace VMS-specific code with GRGCOM. C 13-Dec-1990 [TJP] - make error reading input non-fatal. C 22-Jun-1992 [TJP] - background and foreground colors. C 3-Sep-1992 [WD/TJP] - add PGPLOT_DEV environment variable and C row/column ordering of panels. C 13-Oct-1992 [TJP] - add arrow-head attributes. C 21-Jan-1993 [TJP] - add default for '?' [TJP]. C 17-Mar-1994 [TJP] - initialize color index range [TJP]. C 15-Sep-1994 [TJP] - initialize transfer function [TJP]. C 6-Jun-1995 [TJP] - explicitly initialize PGOPEN [TJP]. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' INTEGER DEFTYP,GRDTYP,GROPEN,L,LR,IC1 INTEGER GRGCOM, IER, LDEFDE REAL DUMMY,DUMMY2,XCSZ CHARACTER*128 DEFDEV CHARACTER*20 DEFSTR CHARACTER*256 REQ LOGICAL JUNK C C Move the initialization of pgopen to a block data subprogram in C pgblck file. John S. Salmento 7/5/95 C C C Close the plot-file if it is already open. C IF (PGOPEN.NE.0) CALL PGEND C C Get the default device/type (environment variable PGPLOT_DEV). C CALL GRGENV('DEV', DEFDEV, LDEFDE) IF (LDEFDE.EQ.0) THEN DEFDEV = '/NULL' LDEFDE = 5 END IF C C Open the plot file; default type is given by environment variable C PGPLOT_TYPE. C CALL GRGENV('TYPE', DEFSTR, L) IF (L.EQ.0) THEN DEFTYP = 0 ELSE CALL GRTOUP(DEFSTR, DEFSTR) DEFTYP = GRDTYP(DEFSTR(1:L)) END IF IF (FILE.EQ.' ') THEN PGBEG = GROPEN(DEFTYP,UNIT,DEFDEV(1:LDEFDE),IDENT) ELSE IF (FILE(1:1).EQ.'?') THEN 10 IF (LDEFDE.EQ.0) THEN IER = GRGCOM(REQ, : 'Graphics device/type (? to see list): ',LR) ELSE IER = GRGCOM(REQ, : 'Graphics device/type (? to see list, default '// : DEFDEV(1:LDEFDE)//'): ',LR) END IF IF (IER.NE.1) THEN CALL GRWARN('Error reading device specification') PGBEG = IER RETURN END IF IF (LR.LT.1 .OR. REQ.EQ.' ') THEN REQ = DEFDEV(1:LDEFDE) ELSE IF (REQ(1:1).EQ.'?') THEN CALL PGLDEV GOTO 10 END IF PGBEG = GROPEN(DEFTYP,UNIT,REQ,IDENT) IF (PGBEG.NE.1) GOTO 10 ELSE PGBEG = GROPEN(DEFTYP,UNIT,FILE,IDENT) END IF C C Failed to open plot file? C IF (PGBEG.NE.1) RETURN C C Success: determine device characteristics. C PGOPEN = 1 ADVSET = 0 PGPFIX = .FALSE. CALL GRSIZE(IDENT,XSZ,YSZ,DUMMY,DUMMY2,XPERIN,YPERIN) CALL GRCHSZ(IDENT,XCSZ,DUMMY,XSP,YSP) PGROWS = .TRUE. IF (NXSUB.LT.0) PGROWS = .FALSE. NX = MAX(ABS(NXSUB),1) NY = MAX(ABS(NYSUB),1) XSZ = XSZ/NX YSZ = YSZ/NY NXC = NX NYC = NY CALL GRQTYP(DEFSTR,JUNK) C C Set the prompt state to ON, so that terminal devices pause between C pages; this can be changed with PGASK. C CALL PGASK(.TRUE.) C C If environment variable PGPLOT_BUFFER is defined (any value), C start buffering output. C PGBLEV = 0 CALL GRGENV('BUFFER', DEFSTR, L) IF (L.GT.0) CALL PGBBUF C C Set background and foreground colors if requested. C CALL GRGENV('BACKGROUND', DEFSTR, L) IF (L.GT.0) CALL PGSCRN(0, DEFSTR(1:L), IER) CALL GRGENV('FOREGROUND', DEFSTR, L) IF (L.GT.0) CALL PGSCRN(1, DEFSTR(1:L), IER) C C Set default attributes. C CALL PGSCI(1) CALL PGSLS(1) CALL PGSLW(1) CALL PGSCH(1.0) CALL PGSCF(1) CALL PGSFS(1) CALL PGSAH(1, 45.0, 0.3) CALL PGSTBG(-1) CALL PGSHS(45.0, 1.0, 0.0) C C Set the default range of color indices available for images (16 to C device maximum, if device maximum >= 16; otherwise not possible). C Select linear transfer function. C CALL GRQCOL(IC1, PGMXCI) PGMNCI = 16 IF (PGMXCI.LT.16) PGMXCI = 0 PGITF = 0 C C Set the default window (unit square). C XBLC = 0.0 XTRC = 1.0 YBLC = 0.0 YTRC = 1.0 C C Set the default viewport. C CALL PGVSTD END pgplot/sys_mac/pgblck.f010064400040640000322000000004410603152306100155740ustar00tjpcitmbr00000400000017 Block Data pgdaa C C Created block data subprogram to initialized variables in common blocks. C John S. Salmento 7/5/95 C INCLUDE 'pgplot.inc' INCLUDE 'grpckg1.inc' DATA PGOPEN/0/ DATA GRSTAT/GRIMAX*0/ C DATA prompt/.False./ Endpgplot/sys_mac/pgpack.f010064400040640000322000000075350577553635200156370ustar00tjpcitmbr00000400000017 PROGRAM PACK C----------------------------------------------------------------------- C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C C 21-Jan-1995 Modified to work on Mac with MPW Fortran 2.1 (Ie. Split grfont.dat into C 3 records, since maximum record length is 32,767). C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000) C INTEGER INDEX(MAXCHR) INTEGER*2 BUFFER(MAXBUF) INTEGER I, LENGTH, LOC, NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open grfont.txt. OPEN (UNIT=1, FILE='grfont.txt', STATUS='OLD', 1 CARRIAGECONTROL='LIST') C C Read input file. C 10 CONTINUE C -- read next character READ (1,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (1,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC BUFFER(LOC) = XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE C C Close input file Close(1) C C Write output file. C C MPW Fortran 2.1 has a maximum record size of 32767 bytes for multiple items in an C unformatted I/O statement. So put NC1, NC2, LOC, and INDEX in one record (The total C length will be 4 * (1 + 1 + 1 + 3000) = 12,012 bytes. Split Index in two put them each C in a record. The length will be 2 * 13000 = 26,000. OPEN (UNIT=2, STATUS='NEW', FORM='UNFORMATTED', FILE='grfont.dat') NC1 = 1 NC2 = 3000 WRITE (2) NC1,NC2,LOC,INDEX Write (2) (BUFFER(I), I = 1, MaxBuf/2) Write (2) (Buffer(I), I = MaxBuf/2 + 1,MaxBuf) CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/sys_mac/pgpage.f010064400040640000322000000063210602624575100156130ustar00tjpcitmbr00000400000017C*PGPAGE -- advance to new page C%void cpgpage(void); C+ SUBROUTINE PGPAGE C C Advance plotter to a new page or panel, clearing the screen if C necessary. If the "prompt state" is ON (see PGASK), confirmation is C requested from the user before clearing the screen. If the view C surface has been subdivided into panels with PGBEG or PGSUBP, then C PGPAGE advances to the next panel, and if the current panel is the C last on the page, PGPAGE clears the screen or starts a new sheet of C paper. PGPAGE does not change the PGPLOT window or the viewport C (in normalized device coordinates); but note that if the size of the C view-surface is changed externally (e.g., by a workstation window C manager) the size of the viewport is chnaged in proportion. C C Arguments: none C-- C 7-Feb-1983 C 23-Sep-1984 - correct bug: call GRTERM at end (if flush mode set). C 31-Jan-1985 - make closer to Fortran-77. C 19-Nov-1987 - explicitly clear the screen if device is interactive; C this restores the behavior obtained with older versions C of GRPCKG. C 9-Feb-1988 - move prompting into routine GRPROM. C 11-Apr-1989 - change name to PGPAGE. C 10-Sep-1990 - add identification labelling. C 11-Feb-1992 - check if device size has changed. C 3-Sep-1992 - allow column ordering of panels. C 17-Nov-1994 - move identification to drivers. C 23-Nov-1994 - fix bug: character size not getting reset. C 23-Jan-1995 - rescale viewport if size of view surface has changed. C----------------------------------------------------------------------- INCLUDE 'pgplot.inc' CHARACTER*16 STR LOGICAL INTER, PGNOTO REAL DUM1, DUM2, XS, YS, XVP1, XVP2, YVP1, YVP2 C IF (PGNOTO('PGPAGE')) RETURN C IF (PGROWS) THEN NXC = NXC + 1 IF (NXC.GT.NX) THEN NXC = 1 NYC = NYC + 1 IF (NYC.GT.NY) NYC = 1 END IF ELSE NYC = NYC + 1 IF (NYC.GT.NY) THEN NYC = 1 NXC = NXC + 1 IF (NXC.GT.NX) NXC = 1 END IF END IF IF (NXC.EQ.1 .AND. NYC.EQ.1) THEN IF (ADVSET.EQ.1 .AND. PROMPT) THEN CALL GRTERM CALL GRQCAP(STR) IF (STR(8:8).EQ.'V') CALL GRPROM C CALL GRPROM END IF CALL GRPAGE IF (.NOT.PGPFIX) THEN C -- Get current viewport in NDC. CALL PGQVP(0, XVP1, XVP2, YVP1, YVP2) C -- Reset view surface size if it has changed CALL GRSIZE(IDENT, XS,YS, DUM1,DUM2, XPERIN,YPERIN) XSZ = XS/NX YSZ = YS/NY C -- and character size CALL PGSCH(PGCHSZ) C -- and viewport CALL PGSVP(XVP1, XVP2, YVP1, YVP2) END IF C C If the device is interactive, call GRBPIC to clear the page. C (If the device is not interactive, GRBPIC will be called C automatically before the first output; omitting the call here C ensures that a blank page is not output.) C CALL GRQTYP(STR,INTER) IF (INTER) CALL GRBPIC END IF XOFF = XVP + (NXC-1)*XSZ YOFF = YVP + (NY-NYC)*YSZ C C Window the plot in the new viewport. C CALL PGVW ADVSET = 1 CALL GRTERM END pgplot/sys_mac/pgplot.make010064400040640000322000001035420607260411000163350ustar00tjpcitmbr00000400000017# Makefile for PGPLOT. # This file is automatically generated. # # This generates the PGPLOT binary files (libraries and demos) in the # current default directory. #----------------------------------------------------------------------- # PGPLOT subdirectories SRCDIR = :src: DEMDIR = :examples: FNTDIR = :fonts: DRVDIR = :drivers: SYSDIR = :sys_mac: GENDIR = :sys: # # FCOMPL contains the name of the fortran compiler. FFLAGC contains the # compiler options for the pgplot routines. FFLAGD contains the compiler # options used for the example programs. To produce 68020 or # or 68030 code, add -mc68020 to FFLAGC or FFLAGD. If you to produce # 68881 or 68882 code, add -mc68881 to FFLAGC or FFLAGD. If you do # use the 68020 or the 68881 then you should used them when compiling the # other files that are link with the pgplot library. If you use the 68881 # option then you also need to link in the FPU libraries, # APS Drive:MPW:Libraries:FLibraries:IntrinsicLibFPU.o, APS Drive:MPW:Libraries:FLibraries:FSANELibFPU.o. FLINK contains # the name of the fortran link command used for creating the example programs. # If mc68881 is used to create pgplot.lib, change FLINK to LinkFortranFPU # instead of LinkFortran. However, I did not get pgdemo1 to work with mc68881. # The other example programs work fine. # FFLAGU contains the compiler options for create_grexec, create_doc, and # pgpack. FLINK contains the link options for these same programs. Using # the mc68881 compiler option probably will not speed up performance in # these programs because very little real operations are performed. I set # the optimization lower since compile time is more important. I also set # the background option higher since these programs do not call many # subroutines. # FCOMPL = FORTRAN FFLAGC = -u -saveall -b -opt=0 -bkg=0 -mc68020 FFLAGD = -u -saveall -b -opt=0 -bkg=0 -mc68020 FFLAGU = -u -saveall -b -opt=0 -bkg=0 -mc68020 FLINK = LinkFortran # # Name of script to set memory size in demo programs. # SizRes = AddSizeResource # # Routine lists. # PG_ROUTINES = ¶ {SRCDIR}pgarro.f.o ¶ {SRCDIR}pgask.f.o ¶ {SRCDIR}pgband.f.o ¶ {SRCDIR}pgbbuf.f.o ¶ {SYSDIR}pgbeg.f.o ¶ {SRCDIR}pgbin.f.o ¶ {SRCDIR}pgbox.f.o ¶ {SRCDIR}pgbox1.f.o ¶ {SRCDIR}pgcirc.f.o ¶ {SRCDIR}pgcl.f.o ¶ {SRCDIR}pgcn01.f.o ¶ {SRCDIR}pgcnsc.f.o ¶ {SRCDIR}pgconb.f.o ¶ {SRCDIR}pgconl.f.o ¶ {SRCDIR}pgcons.f.o ¶ {SRCDIR}pgcont.f.o ¶ {SRCDIR}pgconx.f.o ¶ {SRCDIR}pgcp.f.o ¶ {SRCDIR}pgctab.f.o ¶ {SRCDIR}pgcurs.f.o ¶ {SRCDIR}pgdraw.f.o ¶ {SRCDIR}pgebuf.f.o ¶ {SRCDIR}pgend.f.o ¶ {SRCDIR}pgenv.f.o ¶ {SRCDIR}pgeras.f.o ¶ {SRCDIR}pgerrb.f.o ¶ {SRCDIR}pgerrx.f.o ¶ {SRCDIR}pgerry.f.o ¶ {SRCDIR}pgetxt.f.o ¶ {SRCDIR}pgfunt.f.o ¶ {SRCDIR}pgfunx.f.o ¶ {SRCDIR}pgfuny.f.o ¶ {SRCDIR}pggray.f.o ¶ {SRCDIR}pghi2d.f.o ¶ {SRCDIR}pghis1.f.o ¶ {SRCDIR}pghist.f.o ¶ {SRCDIR}pghtch.f.o ¶ {SRCDIR}pgiden.f.o ¶ {SRCDIR}pgimag.f.o ¶ {SRCDIR}pglab.f.o ¶ {SRCDIR}pglcur.f.o ¶ {SRCDIR}pgldev.f.o ¶ {SRCDIR}pglen.f.o ¶ {SRCDIR}pgline.f.o ¶ {SRCDIR}pgmove.f.o ¶ {SRCDIR}pgmtxt.f.o ¶ {SRCDIR}pgncur.f.o ¶ {SRCDIR}pgnoto.f.o ¶ {SRCDIR}pgnpl.f.o ¶ {SRCDIR}pgnumb.f.o ¶ {SRCDIR}pgolin.f.o ¶ {SYSDIR}pgpage.f.o ¶ {SRCDIR}pgpanl.f.o ¶ {SRCDIR}pgpap.f.o ¶ {SRCDIR}pgpixl.f.o ¶ {SRCDIR}pgpnts.f.o ¶ {SRCDIR}pgpoly.f.o ¶ {SRCDIR}pgpt.f.o ¶ {SRCDIR}pgptxt.f.o ¶ {SRCDIR}pgqah.f.o ¶ {SRCDIR}pgqcf.f.o ¶ {SRCDIR}pgqch.f.o ¶ {SRCDIR}pgqci.f.o ¶ {SRCDIR}pgqcir.f.o ¶ {SRCDIR}pgqcol.f.o ¶ {SRCDIR}pgqcr.f.o ¶ {SRCDIR}pgqcs.f.o ¶ {SRCDIR}pgqfs.f.o ¶ {SRCDIR}pgqhs.f.o ¶ {SRCDIR}pgqinf.f.o ¶ {SRCDIR}pgqitf.f.o ¶ {SRCDIR}pgqls.f.o ¶ {SRCDIR}pgqlw.f.o ¶ {SRCDIR}pgqpos.f.o ¶ {SRCDIR}pgqtbg.f.o ¶ {SRCDIR}pgqtxt.f.o ¶ {SRCDIR}pgqvp.f.o ¶ {SRCDIR}pgqvsz.f.o ¶ {SRCDIR}pgqwin.f.o ¶ {SRCDIR}pgrect.f.o ¶ {SRCDIR}pgrnd.f.o ¶ {SRCDIR}pgrnge.f.o ¶ {SRCDIR}pgsah.f.o ¶ {SRCDIR}pgsave.f.o ¶ {SRCDIR}pgscf.f.o ¶ {SRCDIR}pgsch.f.o ¶ {SRCDIR}pgsci.f.o ¶ {SRCDIR}pgscir.f.o ¶ {SRCDIR}pgscr.f.o ¶ {SRCDIR}pgscrn.f.o ¶ {SRCDIR}pgsfs.f.o ¶ {SRCDIR}pgshls.f.o ¶ {SRCDIR}pgshs.f.o ¶ {SRCDIR}pgsitf.f.o ¶ {SRCDIR}pgsls.f.o ¶ {SRCDIR}pgslw.f.o ¶ {SRCDIR}pgstbg.f.o ¶ {SRCDIR}pgsubp.f.o ¶ {SRCDIR}pgsvp.f.o ¶ {SRCDIR}pgswin.f.o ¶ {SRCDIR}pgtbox.f.o ¶ {SRCDIR}pgtext.f.o ¶ {SRCDIR}pgupdt.f.o ¶ {SRCDIR}pgvect.f.o ¶ {SRCDIR}pgvsiz.f.o ¶ {SRCDIR}pgvstd.f.o ¶ {SRCDIR}pgvw.f.o ¶ {SRCDIR}pgwedg.f.o ¶ {SRCDIR}pgwnad.f.o PG_NON_STANDARD = ¶ {SRCDIR}pgadvance.f.o ¶ {SRCDIR}pgbegin.f.o ¶ {SRCDIR}pgcurse.f.o ¶ {SRCDIR}pglabel.f.o ¶ {SRCDIR}pgmtext.f.o ¶ {SRCDIR}pgncurse.f.o ¶ {SRCDIR}pgpaper.f.o ¶ {SRCDIR}pgpoint.f.o ¶ {SRCDIR}pgptext.f.o ¶ {SRCDIR}pgvport.f.o ¶ {SRCDIR}pgvsize.f.o ¶ {SRCDIR}pgvstand.f.o ¶ {SRCDIR}pgwindow.f.o GR_ROUTINES = ¶ {SRCDIR}grarea.f.o ¶ {SRCDIR}grbpic.f.o ¶ {SRCDIR}grchsz.f.o ¶ {SRCDIR}grclip.f.o ¶ {SRCDIR}grclos.f.o ¶ {SRCDIR}grclpl.f.o ¶ {SRCDIR}grctoi.f.o ¶ {SRCDIR}grcurs.f.o ¶ {SRCDIR}grdot0.f.o ¶ {SRCDIR}grdtyp.f.o ¶ {SRCDIR}gresc.f.o ¶ {SRCDIR}grepic.f.o ¶ {SRCDIR}gretxt.f.o ¶ {SRCDIR}grfa.f.o ¶ {SRCDIR}grfao.f.o ¶ {SYSDIR}grgfil.f.o ¶ {SRCDIR}grgray.f.o ¶ {SRCDIR}grimg0.f.o ¶ {SRCDIR}grimg1.f.o ¶ {SRCDIR}grimg2.f.o ¶ {SRCDIR}grimg3.f.o ¶ {SRCDIR}gritoc.f.o ¶ {SRCDIR}grldev.f.o ¶ {SRCDIR}grlen.f.o ¶ {SRCDIR}grlin0.f.o ¶ {SRCDIR}grlin1.f.o ¶ {SRCDIR}grlin2.f.o ¶ {SRCDIR}grlin3.f.o ¶ {SRCDIR}grlina.f.o ¶ {SRCDIR}grmcur.f.o ¶ {SRCDIR}grmker.f.o ¶ {SRCDIR}grmova.f.o ¶ {SRCDIR}grmsg.f.o ¶ {SYSDIR}gropen.f.o ¶ {SRCDIR}grpage.f.o ¶ {SRCDIR}grpars.f.o ¶ {SRCDIR}grpixl.f.o ¶ {SRCDIR}grpocl.f.o ¶ {SRCDIR}grprom.f.o ¶ {SRCDIR}grpxpo.f.o ¶ {SRCDIR}grpxps.f.o ¶ {SRCDIR}grpxpx.f.o ¶ {SRCDIR}grpxre.f.o ¶ {SRCDIR}grqcap.f.o ¶ {SRCDIR}grqci.f.o ¶ {SRCDIR}grqcol.f.o ¶ {SRCDIR}grqcr.f.o ¶ {SRCDIR}grqdev.f.o ¶ {SRCDIR}grqdt.f.o ¶ {SRCDIR}grqfnt.f.o ¶ {SRCDIR}grqls.f.o ¶ {SRCDIR}grqlw.f.o ¶ {SRCDIR}grqpos.f.o ¶ {SRCDIR}grqtxt.f.o ¶ {SRCDIR}grqtyp.f.o ¶ {SRCDIR}grquit.f.o ¶ {SRCDIR}grrec0.f.o ¶ {SRCDIR}grrect.f.o ¶ {SRCDIR}grsci.f.o ¶ {SRCDIR}grscr.f.o ¶ {SRCDIR}grsetc.f.o ¶ {SRCDIR}grsets.f.o ¶ {SRCDIR}grsfnt.f.o ¶ {SRCDIR}grsize.f.o ¶ {SRCDIR}grskpb.f.o ¶ {SRCDIR}grslct.f.o ¶ {SRCDIR}grsls.f.o ¶ {SRCDIR}grslw.f.o ¶ {SRCDIR}grsyds.f.o ¶ {SRCDIR}grsymk.f.o ¶ {SRCDIR}grsyxd.f.o ¶ {SRCDIR}grterm.f.o ¶ {SRCDIR}grtext.f.o ¶ {SRCDIR}grtoup.f.o ¶ {SRCDIR}grtrim.f.o ¶ {SRCDIR}grtrn0.f.o ¶ {SRCDIR}grtxy0.f.o ¶ {SRCDIR}grvct0.f.o ¶ {SRCDIR}grwarn.f.o ¶ {SRCDIR}grxhls.f.o ¶ {SRCDIR}grxrgb.f.o SYSTEM_ROUTINES = ¶ {SYSDIR}grdate.f.o ¶ {GENDIR}grflun.f.o ¶ {GENDIR}grgcom.f.o ¶ {SYSDIR}grgenv.f.o ¶ {GENDIR}grglun.f.o ¶ {SYSDIR}grgmem.f.o ¶ {GENDIR}grgmsg.f.o ¶ {GENDIR}grlgtr.f.o ¶ {GENDIR}groptx.f.o ¶ {SYSDIR}grsy00.f.o ¶ {SYSDIR}grtrml.f.o ¶ {GENDIR}grtter.f.o ¶ {SYSDIR}gruser.f.o DRIV_LIST = ¶ {DRVDIR}GLDRIV.f.o ¶ {SYSDIR}HGDRIV.f.o ¶ {DRVDIR}HPDRIV.f.o ¶ {DRVDIR}LXDRIV.f.o ¶ {SYSDIR}MCDRIV.f.o ¶ {SYSDIR}MFDRIV.f.o ¶ {DRVDIR}NUDRIV.f.o ¶ {DRVDIR}PSDRIV.f.o OBSOLETE_ROUTINES = ¶ {SRCDIR}grchar.f.o ¶ {SRCDIR}grchr0.f.o ¶ {SRCDIR}grdat2.f.o ¶ {SRCDIR}grgtc0.f.o ¶ {SRCDIR}grinqfont.f.o ¶ {SRCDIR}grinqli.f.o ¶ {SRCDIR}grinqpen.f.o ¶ {SRCDIR}grlinr.f.o ¶ {SRCDIR}grmark.f.o ¶ {SRCDIR}grmovr.f.o ¶ {SRCDIR}grsetfont.f.o ¶ {SRCDIR}grsetli.f.o ¶ {SRCDIR}grsetpen.f.o ¶ {SRCDIR}grtran.f.o ¶ {SRCDIR}grvect.f.o ¶ {SRCDIR}pgsetc.f.o ¶ {SRCDIR}pgsize.f.o MAC_ROUTINES = ¶ {SYSDIR}pgblck.f.o # #----------------------------------------------------------------------- # Rules for compiling the .o files #----------------------------------------------------------------------- # all ÄÄ pgplot.lib grfont.dat demos pgplot.lib ÄÄ {PG_ROUTINES} {PG_NON_STANDARD} {GR_ROUTINES} ¶ grexec.f.o {DRIV_LIST} {SYSTEM_ROUTINES} {MAC_ROUTINES} Lib -f -mf {PG_ROUTINES} ¶ {PG_NON_STANDARD} ¶ {GR_ROUTINES} ¶ {DRIV_LIST} ¶ {SYSTEM_ROUTINES} ¶ {MAC_ROUTINES} ¶ grexec.f.o -o pgplot.lib {SRCDIR}pgarro.f.o Ä {SRCDIR}pgarro.f {FCOMPL} {SRCDIR}pgarro.f {FFLAGC} {SRCDIR}pgask.f.o Ä {SRCDIR}pgask.f pgplot.inc {FCOMPL} {SRCDIR}pgask.f {FFLAGC} {SRCDIR}pgband.f.o Ä {SRCDIR}pgband.f pgplot.inc {FCOMPL} {SRCDIR}pgband.f {FFLAGC} {SRCDIR}pgbbuf.f.o Ä {SRCDIR}pgbbuf.f pgplot.inc {FCOMPL} {SRCDIR}pgbbuf.f {FFLAGC} {SYSDIR}pgbeg.f.o Ä {SYSDIR}pgbeg.f pgplot.inc {FCOMPL} {SYSDIR}pgbeg.f {FFLAGC} {SRCDIR}pgbin.f.o Ä {SRCDIR}pgbin.f {FCOMPL} {SRCDIR}pgbin.f {FFLAGC} {SRCDIR}pgbox.f.o Ä {SRCDIR}pgbox.f pgplot.inc {FCOMPL} {SRCDIR}pgbox.f {FFLAGC} {SRCDIR}pgbox1.f.o Ä {SRCDIR}pgbox1.f {FCOMPL} {SRCDIR}pgbox1.f {FFLAGC} {SRCDIR}pgcirc.f.o Ä {SRCDIR}pgcirc.f pgplot.inc {FCOMPL} {SRCDIR}pgcirc.f {FFLAGC} {SRCDIR}pgcl.f.o Ä {SRCDIR}pgcl.f pgplot.inc {FCOMPL} {SRCDIR}pgcl.f {FFLAGC} {SRCDIR}pgcn01.f.o Ä {SRCDIR}pgcn01.f {FCOMPL} {SRCDIR}pgcn01.f {FFLAGC} {SRCDIR}pgcnsc.f.o Ä {SRCDIR}pgcnsc.f {FCOMPL} {SRCDIR}pgcnsc.f {FFLAGC} {SRCDIR}pgconb.f.o Ä {SRCDIR}pgconb.f {FCOMPL} {SRCDIR}pgconb.f {FFLAGC} {SRCDIR}pgconl.f.o Ä {SRCDIR}pgconl.f pgplot.inc {FCOMPL} {SRCDIR}pgconl.f {FFLAGC} {SRCDIR}pgcons.f.o Ä {SRCDIR}pgcons.f {FCOMPL} {SRCDIR}pgcons.f {FFLAGC} {SRCDIR}pgcont.f.o Ä {SRCDIR}pgcont.f pgplot.inc {FCOMPL} {SRCDIR}pgcont.f {FFLAGC} {SRCDIR}pgconx.f.o Ä {SRCDIR}pgconx.f {FCOMPL} {SRCDIR}pgconx.f {FFLAGC} {SRCDIR}pgcp.f.o Ä {SRCDIR}pgcp.f pgplot.inc {FCOMPL} {SRCDIR}pgcp.f {FFLAGC} {SRCDIR}pgctab.f.o Ä {SRCDIR}pgctab.f {FCOMPL} {SRCDIR}pgctab.f {FFLAGC} {SRCDIR}pgcurs.f.o Ä {SRCDIR}pgcurs.f {FCOMPL} {SRCDIR}pgcurs.f {FFLAGC} {SRCDIR}pgdraw.f.o Ä {SRCDIR}pgdraw.f {FCOMPL} {SRCDIR}pgdraw.f {FFLAGC} {SRCDIR}pgebuf.f.o Ä {SRCDIR}pgebuf.f pgplot.inc {FCOMPL} {SRCDIR}pgebuf.f {FFLAGC} {SRCDIR}pgend.f.o Ä {SRCDIR}pgend.f pgplot.inc {FCOMPL} {SRCDIR}pgend.f {FFLAGC} {SRCDIR}pgenv.f.o Ä {SRCDIR}pgenv.f {FCOMPL} {SRCDIR}pgenv.f {FFLAGC} {SRCDIR}pgeras.f.o Ä {SRCDIR}pgeras.f {FCOMPL} {SRCDIR}pgeras.f {FFLAGC} {SRCDIR}pgerrb.f.o Ä {SRCDIR}pgerrb.f pgplot.inc {FCOMPL} {SRCDIR}pgerrb.f {FFLAGC} {SRCDIR}pgerrx.f.o Ä {SRCDIR}pgerrx.f pgplot.inc {FCOMPL} {SRCDIR}pgerrx.f {FFLAGC} {SRCDIR}pgerry.f.o Ä {SRCDIR}pgerry.f pgplot.inc {FCOMPL} {SRCDIR}pgerry.f {FFLAGC} {SRCDIR}pgetxt.f.o Ä {SRCDIR}pgetxt.f {FCOMPL} {SRCDIR}pgetxt.f {FFLAGC} {SRCDIR}pgfunt.f.o Ä {SRCDIR}pgfunt.f {FCOMPL} {SRCDIR}pgfunt.f {FFLAGC} {SRCDIR}pgfunx.f.o Ä {SRCDIR}pgfunx.f {FCOMPL} {SRCDIR}pgfunx.f {FFLAGC} {SRCDIR}pgfuny.f.o Ä {SRCDIR}pgfuny.f {FCOMPL} {SRCDIR}pgfuny.f {FFLAGC} {SRCDIR}pggray.f.o Ä {SRCDIR}pggray.f pgplot.inc {FCOMPL} {SRCDIR}pggray.f {FFLAGC} {SRCDIR}pghi2d.f.o Ä {SRCDIR}pghi2d.f pgplot.inc {FCOMPL} {SRCDIR}pghi2d.f {FFLAGC} {SRCDIR}pghis1.f.o Ä {SRCDIR}pghis1.f {FCOMPL} {SRCDIR}pghis1.f {FFLAGC} {SRCDIR}pghist.f.o Ä {SRCDIR}pghist.f {FCOMPL} {SRCDIR}pghist.f {FFLAGC} {SRCDIR}pghtch.f.o Ä {SRCDIR}pghtch.f {FCOMPL} {SRCDIR}pghtch.f {FFLAGC} {SRCDIR}pgiden.f.o Ä {SRCDIR}pgiden.f pgplot.inc {FCOMPL} {SRCDIR}pgiden.f {FFLAGC} {SRCDIR}pgimag.f.o Ä {SRCDIR}pgimag.f pgplot.inc {FCOMPL} {SRCDIR}pgimag.f {FFLAGC} {SRCDIR}pglab.f.o Ä {SRCDIR}pglab.f {FCOMPL} {SRCDIR}pglab.f {FFLAGC} {SRCDIR}pglcur.f.o Ä {SRCDIR}pglcur.f {FCOMPL} {SRCDIR}pglcur.f {FFLAGC} {SRCDIR}pgldev.f.o Ä {SRCDIR}pgldev.f {FCOMPL} {SRCDIR}pgldev.f {FFLAGC} {SRCDIR}pglen.f.o Ä {SRCDIR}pglen.f pgplot.inc {FCOMPL} {SRCDIR}pglen.f {FFLAGC} {SRCDIR}pgline.f.o Ä {SRCDIR}pgline.f {FCOMPL} {SRCDIR}pgline.f {FFLAGC} {SRCDIR}pgmove.f.o Ä {SRCDIR}pgmove.f {FCOMPL} {SRCDIR}pgmove.f {FFLAGC} {SRCDIR}pgmtxt.f.o Ä {SRCDIR}pgmtxt.f pgplot.inc {FCOMPL} {SRCDIR}pgmtxt.f {FFLAGC} {SRCDIR}pgncur.f.o Ä {SRCDIR}pgncur.f pgplot.inc {FCOMPL} {SRCDIR}pgncur.f {FFLAGC} {SRCDIR}pgnoto.f.o Ä {SRCDIR}pgnoto.f pgplot.inc {FCOMPL} {SRCDIR}pgnoto.f {FFLAGC} {SRCDIR}pgnpl.f.o Ä {SRCDIR}pgnpl.f {FCOMPL} {SRCDIR}pgnpl.f {FFLAGC} {SRCDIR}pgnumb.f.o Ä {SRCDIR}pgnumb.f {FCOMPL} {SRCDIR}pgnumb.f {FFLAGC} {SRCDIR}pgolin.f.o Ä {SRCDIR}pgolin.f {FCOMPL} {SRCDIR}pgolin.f {FFLAGC} {SYSDIR}pgpage.f.o Ä {SYSDIR}pgpage.f pgplot.inc {FCOMPL} {SYSDIR}pgpage.f {FFLAGC} {SRCDIR}pgpanl.f.o Ä {SRCDIR}pgpanl.f pgplot.inc {FCOMPL} {SRCDIR}pgpanl.f {FFLAGC} {SRCDIR}pgpap.f.o Ä {SRCDIR}pgpap.f pgplot.inc {FCOMPL} {SRCDIR}pgpap.f {FFLAGC} {SRCDIR}pgpixl.f.o Ä {SRCDIR}pgpixl.f {FCOMPL} {SRCDIR}pgpixl.f {FFLAGC} {SRCDIR}pgpnts.f.o Ä {SRCDIR}pgpnts.f {FCOMPL} {SRCDIR}pgpnts.f {FFLAGC} {SRCDIR}pgpoly.f.o Ä {SRCDIR}pgpoly.f pgplot.inc {FCOMPL} {SRCDIR}pgpoly.f {FFLAGC} {SRCDIR}pgpt.f.o Ä {SRCDIR}pgpt.f {FCOMPL} {SRCDIR}pgpt.f {FFLAGC} {SRCDIR}pgptxt.f.o Ä {SRCDIR}pgptxt.f pgplot.inc {FCOMPL} {SRCDIR}pgptxt.f {FFLAGC} {SRCDIR}pgqah.f.o Ä {SRCDIR}pgqah.f pgplot.inc {FCOMPL} {SRCDIR}pgqah.f {FFLAGC} {SRCDIR}pgqcf.f.o Ä {SRCDIR}pgqcf.f {FCOMPL} {SRCDIR}pgqcf.f {FFLAGC} {SRCDIR}pgqch.f.o Ä {SRCDIR}pgqch.f pgplot.inc {FCOMPL} {SRCDIR}pgqch.f {FFLAGC} {SRCDIR}pgqci.f.o Ä {SRCDIR}pgqci.f {FCOMPL} {SRCDIR}pgqci.f {FFLAGC} {SRCDIR}pgqcir.f.o Ä {SRCDIR}pgqcir.f pgplot.inc {FCOMPL} {SRCDIR}pgqcir.f {FFLAGC} {SRCDIR}pgqcol.f.o Ä {SRCDIR}pgqcol.f {FCOMPL} {SRCDIR}pgqcol.f {FFLAGC} {SRCDIR}pgqcr.f.o Ä {SRCDIR}pgqcr.f {FCOMPL} {SRCDIR}pgqcr.f {FFLAGC} {SRCDIR}pgqcs.f.o Ä {SRCDIR}pgqcs.f pgplot.inc {FCOMPL} {SRCDIR}pgqcs.f {FFLAGC} {SRCDIR}pgqfs.f.o Ä {SRCDIR}pgqfs.f pgplot.inc {FCOMPL} {SRCDIR}pgqfs.f {FFLAGC} {SRCDIR}pgqhs.f.o Ä {SRCDIR}pgqhs.f pgplot.inc {FCOMPL} {SRCDIR}pgqhs.f {FFLAGC} {SRCDIR}pgqinf.f.o Ä {SRCDIR}pgqinf.f pgplot.inc {FCOMPL} {SRCDIR}pgqinf.f {FFLAGC} {SRCDIR}pgqitf.f.o Ä {SRCDIR}pgqitf.f pgplot.inc {FCOMPL} {SRCDIR}pgqitf.f {FFLAGC} {SRCDIR}pgqls.f.o Ä {SRCDIR}pgqls.f {FCOMPL} {SRCDIR}pgqls.f {FFLAGC} {SRCDIR}pgqlw.f.o Ä {SRCDIR}pgqlw.f {FCOMPL} {SRCDIR}pgqlw.f {FFLAGC} {SRCDIR}pgqpos.f.o Ä {SRCDIR}pgqpos.f {FCOMPL} {SRCDIR}pgqpos.f {FFLAGC} {SRCDIR}pgqtbg.f.o Ä {SRCDIR}pgqtbg.f pgplot.inc {FCOMPL} {SRCDIR}pgqtbg.f {FFLAGC} {SRCDIR}pgqtxt.f.o Ä {SRCDIR}pgqtxt.f pgplot.inc {FCOMPL} {SRCDIR}pgqtxt.f {FFLAGC} {SRCDIR}pgqvp.f.o Ä {SRCDIR}pgqvp.f pgplot.inc {FCOMPL} {SRCDIR}pgqvp.f {FFLAGC} {SRCDIR}pgqvsz.f.o Ä {SRCDIR}pgqvsz.f pgplot.inc {FCOMPL} {SRCDIR}pgqvsz.f {FFLAGC} {SRCDIR}pgqwin.f.o Ä {SRCDIR}pgqwin.f pgplot.inc {FCOMPL} {SRCDIR}pgqwin.f {FFLAGC} {SRCDIR}pgrect.f.o Ä {SRCDIR}pgrect.f pgplot.inc {FCOMPL} {SRCDIR}pgrect.f {FFLAGC} {SRCDIR}pgrnd.f.o Ä {SRCDIR}pgrnd.f {FCOMPL} {SRCDIR}pgrnd.f {FFLAGC} {SRCDIR}pgrnge.f.o Ä {SRCDIR}pgrnge.f {FCOMPL} {SRCDIR}pgrnge.f {FFLAGC} {SRCDIR}pgsah.f.o Ä {SRCDIR}pgsah.f pgplot.inc {FCOMPL} {SRCDIR}pgsah.f {FFLAGC} {SRCDIR}pgsave.f.o Ä {SRCDIR}pgsave.f {FCOMPL} {SRCDIR}pgsave.f {FFLAGC} {SRCDIR}pgscf.f.o Ä {SRCDIR}pgscf.f {FCOMPL} {SRCDIR}pgscf.f {FFLAGC} {SRCDIR}pgsch.f.o Ä {SRCDIR}pgsch.f pgplot.inc {FCOMPL} {SRCDIR}pgsch.f {FFLAGC} {SRCDIR}pgsci.f.o Ä {SRCDIR}pgsci.f {FCOMPL} {SRCDIR}pgsci.f {FFLAGC} {SRCDIR}pgscir.f.o Ä {SRCDIR}pgscir.f pgplot.inc {FCOMPL} {SRCDIR}pgscir.f {FFLAGC} {SRCDIR}pgscr.f.o Ä {SRCDIR}pgscr.f {FCOMPL} {SRCDIR}pgscr.f {FFLAGC} {SRCDIR}pgscrn.f.o Ä {SRCDIR}pgscrn.f {FCOMPL} {SRCDIR}pgscrn.f {FFLAGC} {SRCDIR}pgsfs.f.o Ä {SRCDIR}pgsfs.f pgplot.inc {FCOMPL} {SRCDIR}pgsfs.f {FFLAGC} {SRCDIR}pgshls.f.o Ä {SRCDIR}pgshls.f {FCOMPL} {SRCDIR}pgshls.f {FFLAGC} {SRCDIR}pgshs.f.o Ä {SRCDIR}pgshs.f pgplot.inc {FCOMPL} {SRCDIR}pgshs.f {FFLAGC} {SRCDIR}pgsitf.f.o Ä {SRCDIR}pgsitf.f pgplot.inc {FCOMPL} {SRCDIR}pgsitf.f {FFLAGC} {SRCDIR}pgsls.f.o Ä {SRCDIR}pgsls.f {FCOMPL} {SRCDIR}pgsls.f {FFLAGC} {SRCDIR}pgslw.f.o Ä {SRCDIR}pgslw.f {FCOMPL} {SRCDIR}pgslw.f {FFLAGC} {SRCDIR}pgstbg.f.o Ä {SRCDIR}pgstbg.f pgplot.inc {FCOMPL} {SRCDIR}pgstbg.f {FFLAGC} {SRCDIR}pgsubp.f.o Ä {SRCDIR}pgsubp.f pgplot.inc {FCOMPL} {SRCDIR}pgsubp.f {FFLAGC} {SRCDIR}pgsvp.f.o Ä {SRCDIR}pgsvp.f pgplot.inc {FCOMPL} {SRCDIR}pgsvp.f {FFLAGC} {SRCDIR}pgswin.f.o Ä {SRCDIR}pgswin.f pgplot.inc {FCOMPL} {SRCDIR}pgswin.f {FFLAGC} {SRCDIR}pgtbox.f.o Ä {SRCDIR}pgtbox.f {FCOMPL} {SRCDIR}pgtbox.f {FFLAGC} {SRCDIR}pgtext.f.o Ä {SRCDIR}pgtext.f {FCOMPL} {SRCDIR}pgtext.f {FFLAGC} {SRCDIR}pgupdt.f.o Ä {SRCDIR}pgupdt.f {FCOMPL} {SRCDIR}pgupdt.f {FFLAGC} {SRCDIR}pgvect.f.o Ä {SRCDIR}pgvect.f {FCOMPL} {SRCDIR}pgvect.f {FFLAGC} {SRCDIR}pgvsiz.f.o Ä {SRCDIR}pgvsiz.f pgplot.inc {FCOMPL} {SRCDIR}pgvsiz.f {FFLAGC} {SRCDIR}pgvstd.f.o Ä {SRCDIR}pgvstd.f pgplot.inc {FCOMPL} {SRCDIR}pgvstd.f {FFLAGC} {SRCDIR}pgvw.f.o Ä {SRCDIR}pgvw.f pgplot.inc {FCOMPL} {SRCDIR}pgvw.f {FFLAGC} {SRCDIR}pgwedg.f.o Ä {SRCDIR}pgwedg.f {FCOMPL} {SRCDIR}pgwedg.f {FFLAGC} {SRCDIR}pgwnad.f.o Ä {SRCDIR}pgwnad.f pgplot.inc {FCOMPL} {SRCDIR}pgwnad.f {FFLAGC} {SRCDIR}pgadvance.f.o Ä {SRCDIR}pgadvance.f {FCOMPL} {SRCDIR}pgadvance.f {FFLAGC} {SRCDIR}pgbegin.f.o Ä {SRCDIR}pgbegin.f {FCOMPL} {SRCDIR}pgbegin.f {FFLAGC} {SRCDIR}pgcurse.f.o Ä {SRCDIR}pgcurse.f {FCOMPL} {SRCDIR}pgcurse.f {FFLAGC} {SRCDIR}pglabel.f.o Ä {SRCDIR}pglabel.f {FCOMPL} {SRCDIR}pglabel.f {FFLAGC} {SRCDIR}pgmtext.f.o Ä {SRCDIR}pgmtext.f {FCOMPL} {SRCDIR}pgmtext.f {FFLAGC} {SRCDIR}pgncurse.f.o Ä {SRCDIR}pgncurse.f {FCOMPL} {SRCDIR}pgncurse.f {FFLAGC} {SRCDIR}pgpaper.f.o Ä {SRCDIR}pgpaper.f {FCOMPL} {SRCDIR}pgpaper.f {FFLAGC} {SRCDIR}pgpoint.f.o Ä {SRCDIR}pgpoint.f {FCOMPL} {SRCDIR}pgpoint.f {FFLAGC} {SRCDIR}pgptext.f.o Ä {SRCDIR}pgptext.f {FCOMPL} {SRCDIR}pgptext.f {FFLAGC} {SRCDIR}pgvport.f.o Ä {SRCDIR}pgvport.f {FCOMPL} {SRCDIR}pgvport.f {FFLAGC} {SRCDIR}pgvsize.f.o Ä {SRCDIR}pgvsize.f {FCOMPL} {SRCDIR}pgvsize.f {FFLAGC} {SRCDIR}pgvstand.f.o Ä {SRCDIR}pgvstand.f {FCOMPL} {SRCDIR}pgvstand.f {FFLAGC} {SRCDIR}pgwindow.f.o Ä {SRCDIR}pgwindow.f {FCOMPL} {SRCDIR}pgwindow.f {FFLAGC} {SRCDIR}grarea.f.o Ä {SRCDIR}grarea.f grpckg1.inc {FCOMPL} {SRCDIR}grarea.f {FFLAGC} {SRCDIR}grbpic.f.o Ä {SRCDIR}grbpic.f grpckg1.inc {FCOMPL} {SRCDIR}grbpic.f {FFLAGC} {SRCDIR}grchsz.f.o Ä {SRCDIR}grchsz.f grpckg1.inc {FCOMPL} {SRCDIR}grchsz.f {FFLAGC} {SRCDIR}grclip.f.o Ä {SRCDIR}grclip.f {FCOMPL} {SRCDIR}grclip.f {FFLAGC} {SRCDIR}grclos.f.o Ä {SRCDIR}grclos.f grpckg1.inc {FCOMPL} {SRCDIR}grclos.f {FFLAGC} {SRCDIR}grclpl.f.o Ä {SRCDIR}grclpl.f grpckg1.inc {FCOMPL} {SRCDIR}grclpl.f {FFLAGC} {SRCDIR}grctoi.f.o Ä {SRCDIR}grctoi.f {FCOMPL} {SRCDIR}grctoi.f {FFLAGC} {SRCDIR}grcurs.f.o Ä {SRCDIR}grcurs.f grpckg1.inc {FCOMPL} {SRCDIR}grcurs.f {FFLAGC} {SRCDIR}grdot0.f.o Ä {SRCDIR}grdot0.f grpckg1.inc {FCOMPL} {SRCDIR}grdot0.f {FFLAGC} {SRCDIR}grdtyp.f.o Ä {SRCDIR}grdtyp.f grpckg1.inc {FCOMPL} {SRCDIR}grdtyp.f {FFLAGC} {SRCDIR}gresc.f.o Ä {SRCDIR}gresc.f grpckg1.inc {FCOMPL} {SRCDIR}gresc.f {FFLAGC} {SRCDIR}grepic.f.o Ä {SRCDIR}grepic.f grpckg1.inc {FCOMPL} {SRCDIR}grepic.f {FFLAGC} {SRCDIR}gretxt.f.o Ä {SRCDIR}gretxt.f grpckg1.inc {FCOMPL} {SRCDIR}gretxt.f {FFLAGC} {SRCDIR}grfa.f.o Ä {SRCDIR}grfa.f grpckg1.inc {FCOMPL} {SRCDIR}grfa.f {FFLAGC} {SRCDIR}grfao.f.o Ä {SRCDIR}grfao.f {FCOMPL} {SRCDIR}grfao.f {FFLAGC} {SYSDIR}grgfil.f.o Ä {SYSDIR}grgfil.f {FCOMPL} {SYSDIR}grgfil.f {FFLAGC} {SRCDIR}grgray.f.o Ä {SRCDIR}grgray.f grpckg1.inc {FCOMPL} {SRCDIR}grgray.f {FFLAGC} {SRCDIR}grimg0.f.o Ä {SRCDIR}grimg0.f grpckg1.inc {FCOMPL} {SRCDIR}grimg0.f {FFLAGC} {SRCDIR}grimg1.f.o Ä {SRCDIR}grimg1.f grpckg1.inc {FCOMPL} {SRCDIR}grimg1.f {FFLAGC} {SRCDIR}grimg2.f.o Ä {SRCDIR}grimg2.f grpckg1.inc {FCOMPL} {SRCDIR}grimg2.f {FFLAGC} {SRCDIR}grimg3.f.o Ä {SRCDIR}grimg3.f grpckg1.inc {FCOMPL} {SRCDIR}grimg3.f {FFLAGC} {SRCDIR}gritoc.f.o Ä {SRCDIR}gritoc.f {FCOMPL} {SRCDIR}gritoc.f {FFLAGC} {SRCDIR}grldev.f.o Ä {SRCDIR}grldev.f grpckg1.inc {FCOMPL} {SRCDIR}grldev.f {FFLAGC} {SRCDIR}grlen.f.o Ä {SRCDIR}grlen.f grpckg1.inc {FCOMPL} {SRCDIR}grlen.f {FFLAGC} {SRCDIR}grlin0.f.o Ä {SRCDIR}grlin0.f grpckg1.inc {FCOMPL} {SRCDIR}grlin0.f {FFLAGC} {SRCDIR}grlin1.f.o Ä {SRCDIR}grlin1.f grpckg1.inc {FCOMPL} {SRCDIR}grlin1.f {FFLAGC} {SRCDIR}grlin2.f.o Ä {SRCDIR}grlin2.f grpckg1.inc {FCOMPL} {SRCDIR}grlin2.f {FFLAGC} {SRCDIR}grlin3.f.o Ä {SRCDIR}grlin3.f grpckg1.inc {FCOMPL} {SRCDIR}grlin3.f {FFLAGC} {SRCDIR}grlina.f.o Ä {SRCDIR}grlina.f grpckg1.inc {FCOMPL} {SRCDIR}grlina.f {FFLAGC} {SRCDIR}grmcur.f.o Ä {SRCDIR}grmcur.f {FCOMPL} {SRCDIR}grmcur.f {FFLAGC} {SRCDIR}grmker.f.o Ä {SRCDIR}grmker.f grpckg1.inc {FCOMPL} {SRCDIR}grmker.f {FFLAGC} {SRCDIR}grmova.f.o Ä {SRCDIR}grmova.f grpckg1.inc {FCOMPL} {SRCDIR}grmova.f {FFLAGC} {SRCDIR}grmsg.f.o Ä {SRCDIR}grmsg.f {FCOMPL} {SRCDIR}grmsg.f {FFLAGC} {SYSDIR}gropen.f.o Ä {SYSDIR}gropen.f grpckg1.inc {FCOMPL} {SYSDIR}gropen.f {FFLAGC} {SRCDIR}grpage.f.o Ä {SRCDIR}grpage.f grpckg1.inc {FCOMPL} {SRCDIR}grpage.f {FFLAGC} {SRCDIR}grpars.f.o Ä {SRCDIR}grpars.f {FCOMPL} {SRCDIR}grpars.f {FFLAGC} {SRCDIR}grpixl.f.o Ä {SRCDIR}grpixl.f grpckg1.inc {FCOMPL} {SRCDIR}grpixl.f {FFLAGC} {SRCDIR}grpocl.f.o Ä {SRCDIR}grpocl.f {FCOMPL} {SRCDIR}grpocl.f {FFLAGC} {SRCDIR}grprom.f.o Ä {SRCDIR}grprom.f {FCOMPL} {SRCDIR}grprom.f {FFLAGC} {SRCDIR}grpxpo.f.o Ä {SRCDIR}grpxpo.f grpckg1.inc {FCOMPL} {SRCDIR}grpxpo.f {FFLAGC} {SRCDIR}grpxps.f.o Ä {SRCDIR}grpxps.f grpckg1.inc {FCOMPL} {SRCDIR}grpxps.f {FFLAGC} {SRCDIR}grpxpx.f.o Ä {SRCDIR}grpxpx.f grpckg1.inc {FCOMPL} {SRCDIR}grpxpx.f {FFLAGC} {SRCDIR}grpxre.f.o Ä {SRCDIR}grpxre.f {FCOMPL} {SRCDIR}grpxre.f {FFLAGC} {SRCDIR}grqcap.f.o Ä {SRCDIR}grqcap.f grpckg1.inc {FCOMPL} {SRCDIR}grqcap.f {FFLAGC} {SRCDIR}grqci.f.o Ä {SRCDIR}grqci.f grpckg1.inc {FCOMPL} {SRCDIR}grqci.f {FFLAGC} {SRCDIR}grqcol.f.o Ä {SRCDIR}grqcol.f grpckg1.inc {FCOMPL} {SRCDIR}grqcol.f {FFLAGC} {SRCDIR}grqcr.f.o Ä {SRCDIR}grqcr.f grpckg1.inc {FCOMPL} {SRCDIR}grqcr.f {FFLAGC} {SRCDIR}grqdev.f.o Ä {SRCDIR}grqdev.f grpckg1.inc {FCOMPL} {SRCDIR}grqdev.f {FFLAGC} {SRCDIR}grqdt.f.o Ä {SRCDIR}grqdt.f grpckg1.inc {FCOMPL} {SRCDIR}grqdt.f {FFLAGC} {SRCDIR}grqfnt.f.o Ä {SRCDIR}grqfnt.f grpckg1.inc {FCOMPL} {SRCDIR}grqfnt.f {FFLAGC} {SRCDIR}grqls.f.o Ä {SRCDIR}grqls.f grpckg1.inc {FCOMPL} {SRCDIR}grqls.f {FFLAGC} {SRCDIR}grqlw.f.o Ä {SRCDIR}grqlw.f grpckg1.inc {FCOMPL} {SRCDIR}grqlw.f {FFLAGC} {SRCDIR}grqpos.f.o Ä {SRCDIR}grqpos.f grpckg1.inc {FCOMPL} {SRCDIR}grqpos.f {FFLAGC} {SRCDIR}grqtxt.f.o Ä {SRCDIR}grqtxt.f grpckg1.inc {FCOMPL} {SRCDIR}grqtxt.f {FFLAGC} {SRCDIR}grqtyp.f.o Ä {SRCDIR}grqtyp.f grpckg1.inc {FCOMPL} {SRCDIR}grqtyp.f {FFLAGC} {SRCDIR}grquit.f.o Ä {SRCDIR}grquit.f {FCOMPL} {SRCDIR}grquit.f {FFLAGC} {SRCDIR}grrec0.f.o Ä {SRCDIR}grrec0.f grpckg1.inc {FCOMPL} {SRCDIR}grrec0.f {FFLAGC} {SRCDIR}grrect.f.o Ä {SRCDIR}grrect.f grpckg1.inc {FCOMPL} {SRCDIR}grrect.f {FFLAGC} {SRCDIR}grsci.f.o Ä {SRCDIR}grsci.f grpckg1.inc {FCOMPL} {SRCDIR}grsci.f {FFLAGC} {SRCDIR}grscr.f.o Ä {SRCDIR}grscr.f grpckg1.inc {FCOMPL} {SRCDIR}grscr.f {FFLAGC} {SRCDIR}grsetc.f.o Ä {SRCDIR}grsetc.f grpckg1.inc {FCOMPL} {SRCDIR}grsetc.f {FFLAGC} {SRCDIR}grsets.f.o Ä {SRCDIR}grsets.f grpckg1.inc {FCOMPL} {SRCDIR}grsets.f {FFLAGC} {SRCDIR}grsfnt.f.o Ä {SRCDIR}grsfnt.f grpckg1.inc {FCOMPL} {SRCDIR}grsfnt.f {FFLAGC} {SRCDIR}grsize.f.o Ä {SRCDIR}grsize.f grpckg1.inc {FCOMPL} {SRCDIR}grsize.f {FFLAGC} {SRCDIR}grskpb.f.o Ä {SRCDIR}grskpb.f {FCOMPL} {SRCDIR}grskpb.f {FFLAGC} {SRCDIR}grslct.f.o Ä {SRCDIR}grslct.f grpckg1.inc {FCOMPL} {SRCDIR}grslct.f {FFLAGC} {SRCDIR}grsls.f.o Ä {SRCDIR}grsls.f grpckg1.inc {FCOMPL} {SRCDIR}grsls.f {FFLAGC} {SRCDIR}grslw.f.o Ä {SRCDIR}grslw.f grpckg1.inc {FCOMPL} {SRCDIR}grslw.f {FFLAGC} {SRCDIR}grsyds.f.o Ä {SRCDIR}grsyds.f {FCOMPL} {SRCDIR}grsyds.f {FFLAGC} {SRCDIR}grsymk.f.o Ä {SRCDIR}grsymk.f {FCOMPL} {SRCDIR}grsymk.f {FFLAGC} {SRCDIR}grsyxd.f.o Ä {SRCDIR}grsyxd.f {FCOMPL} {SRCDIR}grsyxd.f {FFLAGC} {SRCDIR}grterm.f.o Ä {SRCDIR}grterm.f grpckg1.inc {FCOMPL} {SRCDIR}grterm.f {FFLAGC} {SRCDIR}grtext.f.o Ä {SRCDIR}grtext.f grpckg1.inc {FCOMPL} {SRCDIR}grtext.f {FFLAGC} {SRCDIR}grtoup.f.o Ä {SRCDIR}grtoup.f {FCOMPL} {SRCDIR}grtoup.f {FFLAGC} {SRCDIR}grtrim.f.o Ä {SRCDIR}grtrim.f {FCOMPL} {SRCDIR}grtrim.f {FFLAGC} {SRCDIR}grtrn0.f.o Ä {SRCDIR}grtrn0.f grpckg1.inc {FCOMPL} {SRCDIR}grtrn0.f {FFLAGC} {SRCDIR}grtxy0.f.o Ä {SRCDIR}grtxy0.f grpckg1.inc {FCOMPL} {SRCDIR}grtxy0.f {FFLAGC} {SRCDIR}grvct0.f.o Ä {SRCDIR}grvct0.f grpckg1.inc {FCOMPL} {SRCDIR}grvct0.f {FFLAGC} {SRCDIR}grwarn.f.o Ä {SRCDIR}grwarn.f {FCOMPL} {SRCDIR}grwarn.f {FFLAGC} {SRCDIR}grxhls.f.o Ä {SRCDIR}grxhls.f {FCOMPL} {SRCDIR}grxhls.f {FFLAGC} {SRCDIR}grxrgb.f.o Ä {SRCDIR}grxrgb.f {FCOMPL} {SRCDIR}grxrgb.f {FFLAGC} {SYSDIR}grdate.f.o Ä {SYSDIR}grdate.f {FCOMPL} {SYSDIR}grdate.f {FFLAGC} {GENDIR}grflun.f.o Ä {GENDIR}grflun.f {FCOMPL} {GENDIR}grflun.f {FFLAGC} {GENDIR}grgcom.f.o Ä {GENDIR}grgcom.f {FCOMPL} {GENDIR}grgcom.f {FFLAGC} {SYSDIR}grgenv.f.o Ä {SYSDIR}grgenv.f {FCOMPL} {SYSDIR}grgenv.f {FFLAGC} {GENDIR}grglun.f.o Ä {GENDIR}grglun.f {FCOMPL} {GENDIR}grglun.f {FFLAGC} {SYSDIR}grgmem.f.o Ä {SYSDIR}grgmem.f {FCOMPL} {SYSDIR}grgmem.f {FFLAGC} {GENDIR}grgmsg.f.o Ä {GENDIR}grgmsg.f {FCOMPL} {GENDIR}grgmsg.f {FFLAGC} {GENDIR}grlgtr.f.o Ä {GENDIR}grlgtr.f {FCOMPL} {GENDIR}grlgtr.f {FFLAGC} {GENDIR}groptx.f.o Ä {GENDIR}groptx.f {FCOMPL} {GENDIR}groptx.f {FFLAGC} {SYSDIR}grsy00.f.o Ä {SYSDIR}grsy00.f {FCOMPL} {SYSDIR}grsy00.f {FFLAGC} {SYSDIR}grtrml.f.o Ä {SYSDIR}grtrml.f {FCOMPL} {SYSDIR}grtrml.f {FFLAGC} {GENDIR}grtter.f.o Ä {GENDIR}grtter.f {FCOMPL} {GENDIR}grtter.f {FFLAGC} {SYSDIR}gruser.f.o Ä {SYSDIR}gruser.f {FCOMPL} {SYSDIR}gruser.f {FFLAGC} {DRVDIR}GLDRIV.f.o Ä {DRVDIR}GLDRIV.f {FCOMPL} {DRVDIR}GLDRIV.f {FFLAGC} {SYSDIR}HGDRIV.f.o Ä {SYSDIR}HGDRIV.f {FCOMPL} {SYSDIR}HGDRIV.f {FFLAGC} {DRVDIR}HPDRIV.f.o Ä {DRVDIR}HPDRIV.f {FCOMPL} {DRVDIR}HPDRIV.f {FFLAGC} {DRVDIR}LXDRIV.f.o Ä {DRVDIR}LXDRIV.f {FCOMPL} {DRVDIR}LXDRIV.f {FFLAGC} {SYSDIR}MCDRIV.f.o Ä {SYSDIR}MCDRIV.f {FCOMPL} {SYSDIR}MCDRIV.f -u -b -opt=0 -bkg=0 -mc68020 {SYSDIR}MFDRIV.f.o Ä {SYSDIR}MFDRIV.f {FCOMPL} {SYSDIR}MFDRIV.f {FFLAGC} {DRVDIR}NUDRIV.f.o Ä {DRVDIR}NUDRIV.f {FCOMPL} {DRVDIR}NUDRIV.f {FFLAGC} {DRVDIR}PSDRIV.f.o Ä {DRVDIR}PSDRIV.f {FCOMPL} {DRVDIR}PSDRIV.f {FFLAGC} grexec.f.o Ä grexec.f {FCOMPL} grexec.f {FFLAGC} grexec.f Ä drivers.list :sys_mac:create_grexec.f Directory {SYSDIR} {FCOMPL} create_grexec.f {FFLAGU} LinkFORTRANtool create_grexec create_grexec.f.o Move -y create_grexec :: Directory :: create_grexec {SYSDIR}pgblck.f.o Ä {SYSDIR}pgblck.f grpckg1.inc pgplot.inc {FCOMPL} {SYSDIR}pgblck.f {FFLAGC} pgplotold.lib ÄÄ {OBSOLETE_ROUTINES} Lib -f -mf {OBSOLETE_ROUTINES} -o pgplotold.lib {SRCDIR}grchar.f.o Ä {SRCDIR}grchar.f {FCOMPL} {SRCDIR}grchar.f {FFLAGC} {SRCDIR}grchr0.f.o Ä {SRCDIR}grchr0.f grpckg1.inc {FCOMPL} {SRCDIR}grchr0.f {FFLAGC} {SRCDIR}grdat2.f.o Ä {SRCDIR}grdat2.f {FCOMPL} {SRCDIR}grdat2.f {FFLAGC} {SRCDIR}grgtc0.f.o Ä {SRCDIR}grgtc0.f {FCOMPL} {SRCDIR}grgtc0.f {FFLAGC} {SRCDIR}grinqfont.f.o Ä {SRCDIR}grinqfont.f {FCOMPL} {SRCDIR}grinqfont.f {FFLAGC} {SRCDIR}grinqli.f.o Ä {SRCDIR}grinqli.f {FCOMPL} {SRCDIR}grinqli.f {FFLAGC} {SRCDIR}grinqpen.f.o Ä {SRCDIR}grinqpen.f {FCOMPL} {SRCDIR}grinqpen.f {FFLAGC} {SRCDIR}grlinr.f.o Ä {SRCDIR}grlinr.f grpckg1.inc {FCOMPL} {SRCDIR}grlinr.f {FFLAGC} {SRCDIR}grmark.f.o Ä {SRCDIR}grmark.f {FCOMPL} {SRCDIR}grmark.f {FFLAGC} {SRCDIR}grmovr.f.o Ä {SRCDIR}grmovr.f grpckg1.inc {FCOMPL} {SRCDIR}grmovr.f {FFLAGC} {SRCDIR}grsetfont.f.o Ä {SRCDIR}grsetfont.f {FCOMPL} {SRCDIR}grsetfont.f {FFLAGC} {SRCDIR}grsetli.f.o Ä {SRCDIR}grsetli.f grpckg1.inc {FCOMPL} {SRCDIR}grsetli.f {FFLAGC} {SRCDIR}grsetpen.f.o Ä {SRCDIR}grsetpen.f {FCOMPL} {SRCDIR}grsetpen.f {FFLAGC} {SRCDIR}grtran.f.o Ä {SRCDIR}grtran.f {FCOMPL} {SRCDIR}grtran.f {FFLAGC} {SRCDIR}grvect.f.o Ä {SRCDIR}grvect.f {FCOMPL} {SRCDIR}grvect.f {FFLAGC} {SRCDIR}pgsetc.f.o Ä {SRCDIR}pgsetc.f {FCOMPL} {SRCDIR}pgsetc.f {FFLAGC} {SRCDIR}pgsize.f.o Ä {SRCDIR}pgsize.f {FCOMPL} {SRCDIR}pgsize.f {FFLAGC} demos ÄÄ {DEMDIR}pgdemo1 {DEMDIR}pgdemo2 {DEMDIR}pgdemo3 {DEMDIR}pgdemo4 {DEMDIR}pgdemo5 {DEMDIR}pgdemo6 {DEMDIR}pgdemo7 {DEMDIR}pgdemo8 {DEMDIR}pgdemo9 {DEMDIR}pgdemo10 {DEMDIR}pgdemo11 {DEMDIR}pgdemo12 pgplot.lib Echo `Date -t` Creating demonstration programs. {DEMDIR}pgdemo1 Ä {DEMDIR}pgdemo1.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo1 {DEMDIR}pgdemo1.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo1 {SizRes} {DEMDIR}pgdemo1 512 {DEMDIR}pgdemo2 Ä {DEMDIR}pgdemo2.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo2 {DEMDIR}pgdemo2.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo2 {SizRes} {DEMDIR}pgdemo2 512 {DEMDIR}pgdemo3 Ä {DEMDIR}pgdemo3.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo3 {DEMDIR}pgdemo3.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo3 {SizRes} {DEMDIR}pgdemo3 1024 {DEMDIR}pgdemo4 Ä {DEMDIR}pgdemo4.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo4 {DEMDIR}pgdemo4.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo4 {SizRes} {DEMDIR}pgdemo4 512 {DEMDIR}pgdemo5 Ä {DEMDIR}pgdemo5.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo5 {DEMDIR}pgdemo5.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo5 {SizRes} {DEMDIR}pgdemo5 512 {DEMDIR}pgdemo6 Ä {DEMDIR}pgdemo6.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo6 {DEMDIR}pgdemo6.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo6 {SizRes} {DEMDIR}pgdemo6 512 {DEMDIR}pgdemo7 Ä {DEMDIR}pgdemo7.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo7 {DEMDIR}pgdemo7.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo7 {SizRes} {DEMDIR}pgdemo7 512 {DEMDIR}pgdemo8 Ä {DEMDIR}pgdemo8.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo8 {DEMDIR}pgdemo8.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo8 {SizRes} {DEMDIR}pgdemo8 512 {DEMDIR}pgdemo9 Ä {DEMDIR}pgdemo9.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo9 {DEMDIR}pgdemo9.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo9 {SizRes} {DEMDIR}pgdemo9 512 {DEMDIR}pgdemo10 Ä {DEMDIR}pgdemo10.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo10 {DEMDIR}pgdemo10.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo10 {SizRes} {DEMDIR}pgdemo10 512 {DEMDIR}pgdemo11 Ä {DEMDIR}pgdemo11.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo11 {DEMDIR}pgdemo11.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo11 {SizRes} {DEMDIR}pgdemo11 512 {DEMDIR}pgdemo12 Ä {DEMDIR}pgdemo12.f.o pgplot.lib {FLINK} {DEMDIR}pgdemo12 {DEMDIR}pgdemo12.f.o pgplot.lib AddResourceFile {DEMDIR}pgdemo12 {SizRes} {DEMDIR}pgdemo12 512 {DEMDIR}pgdemo1.f.o Ä {DEMDIR}pgdemo1.f {FCOMPL} {DEMDIR}pgdemo1.f {FFLAGD} {DEMDIR}pgdemo2.f.o Ä {DEMDIR}pgdemo2.f {FCOMPL} {DEMDIR}pgdemo2.f {FFLAGD} {DEMDIR}pgdemo3.f.o Ä {DEMDIR}pgdemo3.f {FCOMPL} {DEMDIR}pgdemo3.f {FFLAGD} {DEMDIR}pgdemo4.f.o Ä {DEMDIR}pgdemo4.f {FCOMPL} {DEMDIR}pgdemo4.f {FFLAGD} {DEMDIR}pgdemo5.f.o Ä {DEMDIR}pgdemo5.f {FCOMPL} {DEMDIR}pgdemo5.f {FFLAGD} {DEMDIR}pgdemo6.f.o Ä {DEMDIR}pgdemo6.f {FCOMPL} {DEMDIR}pgdemo6.f {FFLAGD} {DEMDIR}pgdemo7.f.o Ä {DEMDIR}pgdemo7.f {FCOMPL} {DEMDIR}pgdemo7.f {FFLAGD} {DEMDIR}pgdemo8.f.o Ä {DEMDIR}pgdemo8.f {FCOMPL} {DEMDIR}pgdemo8.f {FFLAGD} {DEMDIR}pgdemo9.f.o Ä {DEMDIR}pgdemo9.f {FCOMPL} {DEMDIR}pgdemo9.f {FFLAGD} {DEMDIR}pgdemo10.f.o Ä {DEMDIR}pgdemo10.f {FCOMPL} {DEMDIR}pgdemo10.f {FFLAGD} {DEMDIR}pgdemo11.f.o Ä {DEMDIR}pgdemo11.f {FCOMPL} {DEMDIR}pgdemo11.f {FFLAGD} {DEMDIR}pgdemo12.f.o Ä {DEMDIR}pgdemo12.f {FCOMPL} {DEMDIR}pgdemo12.f {FFLAGD} grfont.dat ÄÄ {FNTDIR}grfont.txt {SYSDIR}pgpack.f Duplicate -y {SYSDIR}pgpack.f {FNTDIR} Directory {FNTDIR} If grfont.dat == `Exists -f grfont.dat` Delete grfont.dat End FORTRAN pgpack.f {FFLAGU} LinkFORTRANtool pgpack pgpack.f.o Echo `Date -t` Executing pgpack, which takes a while and the ball does not spin. ¶n¶ Should report: ¶n¶ Characters defined: 996 ¶n¶ Array cells used: 26732 pgpack Echo `Date -t` Finished creating grfont.dat. Directory :: pgplot.doc ÄÄ :sys_mac:create_doc.f Directory {SYSDIR} {FCOMPL} create_doc.f {FFLAGU} LinkFORTRANtool create_doc create_doc.f.o Move -y create_doc :: Directory :: Echo `Date -t` Executing create_doc, which takes a long time and the ball does not spin. create_doc {SRCDIR} ¶ pgarro.f ¶ pgask.f ¶ pgband.f ¶ pgbbuf.f ¶ pgbeg.f ¶ pgbin.f ¶ pgbox.f ¶ pgbox1.f ¶ pgcirc.f ¶ pgcl.f ¶ pgcn01.f ¶ pgcnsc.f ¶ pgconb.f ¶ pgconl.f ¶ pgcons.f ¶ pgcont.f ¶ pgconx.f ¶ pgcp.f ¶ pgctab.f ¶ pgcurs.f ¶ pgdraw.f ¶ pgebuf.f ¶ pgend.f ¶ pgenv.f ¶ pgeras.f ¶ pgerrb.f ¶ pgerrx.f ¶ pgerry.f ¶ pgetxt.f ¶ pgfunt.f ¶ pgfunx.f ¶ pgfuny.f ¶ pggray.f ¶ pghi2d.f ¶ pghis1.f ¶ pghist.f ¶ pghtch.f ¶ pgiden.f ¶ pgimag.f ¶ pglab.f ¶ pglcur.f ¶ pgldev.f ¶ pglen.f ¶ pgline.f ¶ pgmove.f ¶ pgmtxt.f ¶ pgncur.f ¶ pgnoto.f ¶ pgnpl.f ¶ pgnumb.f ¶ pgolin.f ¶ pgpage.f ¶ pgpanl.f ¶ pgpap.f ¶ pgpixl.f ¶ pgpnts.f ¶ pgpoly.f ¶ pgpt.f ¶ pgptxt.f ¶ pgqah.f ¶ pgqcf.f ¶ pgqch.f ¶ pgqci.f ¶ pgqcir.f ¶ pgqcol.f ¶ pgqcr.f ¶ pgqcs.f ¶ pgqfs.f ¶ pgqhs.f ¶ pgqinf.f ¶ pgqitf.f ¶ pgqls.f ¶ pgqlw.f ¶ pgqpos.f ¶ pgqtbg.f ¶ pgqtxt.f ¶ pgqvp.f ¶ pgqvsz.f ¶ pgqwin.f ¶ pgrect.f ¶ pgrnd.f ¶ pgrnge.f ¶ pgsah.f ¶ pgsave.f ¶ pgscf.f ¶ pgsch.f ¶ pgsci.f ¶ pgscir.f ¶ pgscr.f ¶ pgscrn.f ¶ pgsfs.f ¶ pgshls.f ¶ pgshs.f ¶ pgsitf.f ¶ pgsls.f ¶ pgslw.f ¶ pgstbg.f ¶ pgsubp.f ¶ pgsvp.f ¶ pgswin.f ¶ pgtbox.f ¶ pgtext.f ¶ pgupdt.f ¶ pgvect.f ¶ pgvsiz.f ¶ pgvstd.f ¶ pgvw.f ¶ pgwedg.f ¶ pgwnad.f Echo `Date -t` Finished creating pgplot.html and pgplot.doc. clean ÄÄ Delete -i {PG_ROUTINES} ¶ {PG_NON_STANDARD} ¶ {GR_ROUTINES} ¶ grexec.f.o {DRIV_LIST} ¶ {SYSTEM_ROUTINES} ¶ {MAC_ROUTINES} f {FCOMPL} {SRCDIR}grsymk.f {FFLAGC} {SRCDIR}grsyxd.f.o Ä {SRCDIR}grsyxd.f {FCOMPL} {SRCDIR}grsyxd.f {FFLAGC} {SRCDIR}grterm.f.o Ä {SRCDIR}grterm.f grpgplot/sys_mac/pgplotenvnames010064400040640000322000000002750603254325000171600ustar00tjpcitmbr00000400000017PGPLOT_FONT 'APS Drive:MPW:pgplot:fonts:grfont.dat' PGPLOT_DIR 'APS Drive:MPW:pgplot:' PGPLOT_RGB 'APS Drive:MPW:pgplot:rgb.txt' PGPLOT_DEV '/MAC' PGPLOT_DEBUG 'OFF' PGPLOT_MACPICTURE 'ON' pgplot/sys_mac/ppcnative.version010064400040640000322000000040270607724217300176030ustar00tjpcitmbr00000400000017I don't have a ppc so I can't say what modifications are needed to get Pgplot running in native mode with the LS compiler. However, Mike Burnett (contact him mnb@ornl.gov if you have any questions about these modifications) has contributed the following instructions. I haven't tested them so I can't say it they will work. Hopefully, in the near future I will update the macmake, pgplot.make, and mcdriv.f files to incorportate his changes. To compile on the PowerMac, change the 2 occurrences of the following line in mcdriv.f, QDG = JQDGLOBALS() to !!IFC NOT LSPOWERF QDG = JQDGLOBALS() !!ELSEC QDG = %loc(qd) !!ENDC Change pgplot.make as follows: 1. Replace all occurrances of LinkFortranTool with {LINKTOOL}. 2. Replace both occurrances of "lib -f -mf" with {LIBLINK} 3. Add the CMPMCDRV definition after FFLAGU near the top of pgplot.make. 4. Change the following line in pgplot.make {FCOMPL} {SYSDIR}MCDRIV.f {FFLAGC} to {CMPMCDRV} {SYSDIR}MCDRIV.f 5. Add the LINKTOOL and LIBLINK definitions after FLINK near the top of pgplot.make. Then change the global variable definitions as follows: To compile for 68020: FCOMPL = FORTRAN FFLAGC = -u -saveall -b -opt=0 -bkg=0 -mc68020 FFLAGD = -u -saveall -b -opt=0 -bkg=0 -mc68020 CMPMCDRV = FORTRAN -u -b -opt=0 -bkg=0 -mc68020 FFLAGU = -u -saveall -b -opt=0 -bkg=0 -mc68020 FLINK = LinkFortran LINKTOOL = LinkFortranTool LIBLINK = Lib -f -mf To compile for PPC: FCOMPL = FORTRAN.PPC FFLAGC = -u -saveall -b -opt=0 -bkg=0 FFLAGD = -u -saveall -b -opt=0 -bkg=0 FFLAGU = -u -saveall -b -opt=0 -bkg=0 CMPMCDRV = FORTRAN.PPC -u -b -opt=0 -bkg=0 FLINK = LinkFortranPPC LINKTOOL = LinkFortranToolPPC LIBLINK = PPCLink -xm l -mf Mike adds the following comments. In LIBLINK for the PPC, that is a small L after the xm. This produces a static library. PPCLink doesn't have a -f option like Lib does. I don't see anything equivalent. I hope that doesn't matter. The demos run a LOT faster on a PowerMac with the PPC compilation. pgplot/sys_mac/Toolbox010064400040640000322000000004030576211264100155420ustar00tjpcitmbr00000400000017 program makeglobals !!setc usingincludes = .false. !!I Windows.f !!I Menus.f !!I Dialogs.f !!I Errors.f !!I Events.f !!I Packages.f !!I Quickdraw.f !!I Textedit.f !!I Scrap.f !!| Printing.f end c This is the file used to create the c Toolbox.finc file.pgplot/sys_mac/crosshair.txt010064400040640000322000000040120610120255400167160ustar00tjpcitmbr00000400000017Hi John, Well, I nearly have a presentable version of the PGPLOT driver ready for Absoft MacFortran. A final query and an offer. Does your version respond to the mouse button for cursor input? In regards to cursor input I can offer you my version of the commands to replace the cursor with a crosshair for this operation. All it takes is c define cursor for graphic input record /Cursor/ GIcursor ! check how LS Fortran defines this structure! GIcursor.data(0) = b'0000000000000000' GIcursor.data(1) = b'0000000010000000' GIcursor.data(2) = b'0000000010000000' GIcursor.data(3) = b'0000000010000000' GIcursor.data(4) = b'0000000010000000' GIcursor.data(5) = b'0000000010000000' GIcursor.data(6) = b'0000000010000000' GIcursor.data(7) = b'0000000000000000' GIcursor.data(8) = b'0111111000111111' GIcursor.data(9) = b'0000000000000000' GIcursor.data(10)= b'0000000010000000' GIcursor.data(11)= b'0000000010000000' GIcursor.data(12)= b'0000000010000000' GIcursor.data(13)= b'0000000010000000' GIcursor.data(14)= b'0000000010000000' GIcursor.data(15)= b'0000000010000000' do 910 i=0,15 GIcursor.mask(i)=GIcursor.data(i) 910 continue GIcursor.hotSpot.v=8 GIcursor.hotSpot.h=8 call SetCursor(GIcursor) event loop to wait for input call InitCursor() ! reset the cursor I had written a driver for a different plot library several years ago when I came up with this. I really liked how you changed the window title to instruct the user on the cursor input and next plot requirements. I also implemented a way to update the window when updating is required. I allocated a handle and saved the opcodes that draw to the screen or set internal parameters. Let me know if you want the code to modify for LS Fortran. *-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*- Rob Managan managan@llnl.gov LLNL ph: 510-423-0903 P.O. Box 808, L-178 FAX: 510-423-5804 Livermore, CA 94551-0808 pgplot/sys_msdos/grdos.f010064400040640000322000000176170613655220000160550ustar00tjpcitmbr00000400000017 include 'flib.fi' C*GRDATE -- get date and time as character string (MS-DOS) C+ SUBROUTINE GRDATE(CDATE, LDATE) include 'flib.fd' CHARACTER CDATE*(17) INTEGER LDATE C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the CDATE should be declared C CHARACTER*17. C C Arguments: C CDATE : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 1989-Mar-17 - [AFT] C 12/1993 C. T. Dum MS Power Station F32 Version C----------------------------------------------------------------------- CHARACTER CMON(12)*3 INTEGER*2 IHR, IMIN, ISEC, I100TH INTEGER*2 IYR, IMON, IDAY DATA CMON/'Jan','Feb','Mar','Apr','May','Jun', : 'Jul','Aug','Sep','Oct','Nov','Dec'/ C--- CALL GETTIM(IHR, IMIN, ISEC, I100TH) CALL GETDAT(IYR, IMON, IDAY) WRITE(CDATE,111) IDAY,CMON(IMON),IYR,IHR,IMIN 111 FORMAT(I2,'-',A3,'-',I4,' ',I2,':',I2) LDATE=17 RETURN END C*GRFLUN -- free a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. [This version C is pretty stupid; GRGLUN allocates units starting at 81, and GRFLUN C does not free units.] C C Arguments: C LUN : the logical unit number to free. C-- C 25-Nov-1988 C----------------------------------------------------------------------- RETURN END C*GRGCOM -- read with prompt from user's terminal (MS-DOS) C+ INTEGER FUNCTION GRGCOM(CREAD, CPROM, LREAD) CHARACTER CREAD*(*), CPROM*(*) INTEGER LREAD C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C CREAD : (output) receives the string read from the terminal. C CPROM : (input) prompt string. C LREAD : (output) length of CREAD. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 1989-Mar-29 ctd 3/95:len_trim (MS Fortran) C----------------------------------------------------------------------- INTEGER IER C--- 11 FORMAT(A) C--- GRGCOM = 0 LREAD = 0 WRITE (*, 101, IOSTAT=IER) CPROM 101 FORMAT(1X,A,\) IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CREAD IF (IER.EQ.0) GRGCOM = 1 LREAD = LEN_TRIM(CREAD) RETURN END C*GRGENV -- get value of PGPLOT environment parameter (MS-DOS) C+ SUBROUTINE GRGENV(CNAME, CVALUE, LVALUE) include 'flib.fd' CHARACTER CNAME*(*), CVALUE*(*) INTEGER LVALUE C C Return the value of a PGPLOT environment parameter. C C Arguments: C CNAME : (input) the name of the parameter to evaluate. C CVALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C LVALUE : receives the number of characters in CVALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 1990-Mar-19 - [AFT] C 12/93;3/95 CTD F32 C----------------------------------------------------------------------- C CHARACTER*80 CTMP,CTEMP INTEGER LTMP CTMP = 'PGPLOT_'//CNAME LTMP = INDEX(CTMP,' ') LVALUE=GETENVQQ(CTMP(:LTMP-1),CTEMP) IF(LVALUE.NE.0)THEN CVALUE = CTEMP(:LVALUE) ELSE CVALUE = ' ' ENDIF RETURN END C*GRGLUN -- get a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Get an unused Fortran logical unit number. C Returns a Logical Unit Number that is not currently opened. C After GRGLUN is called, the unit should be opened to reserve C the unit number for future calls. Once a unit is closed, it C becomes free and another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 C as older software will often use these units without warning. C C Arguments: C LUN : receives the logical unit number, or -1 on error. C-- C 12-Feb-1989 [AFT/TJP]. C----------------------------------------------------------------------- INTEGER I LOGICAL QOPEN C--- DO 10 I=99,10,-1 INQUIRE (UNIT=I, OPENED=QOPEN) IF (.NOT.QOPEN) THEN LUN = I RETURN END IF 10 CONTINUE CALL GRWARN('GRGLUN: out of units.') LUN = -1 RETURN END C*GRLGTR -- translate logical name (MS-DOS) C+ SUBROUTINE GRLGTR (CNAME) CHARACTER CNAME*(*) C C Recursive translation of a logical name. C Up to 20 levels of equivalencing can be handled. C This is used in the parsing of device specifications in the C VMS implementation of PGPLOT. In other implementations, it may C be replaced by a null routine. C C Argument: C CNAME (input/output): initially contains the name to be C inspected. If an equivalence is found it will be replaced C with the new name. If not, the old name will be left there. The C escape sequence at the beginning of process-permanent file C names is deleted and the '_' character at the beginning of C device names is left in place. C-- C 18-Feb-1988 C----------------------------------------------------------------------- RETURN END C*GROPTX -- open output text file [MS-DOS] C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE) INTEGER UNIT,MODE CHARACTER*(*) NAME,DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER) GROPTX = IER RETURN C----------------------------------------------------------------------- END C*GRTRML -- get name of user's terminal (MS-DOS) C+ SUBROUTINE GRTRML(CTERM, LTERM) CHARACTER CTERM*(*) INTEGER LTERM C C Return the device name of the user's terminal, if any. C C Arguments: C CTERM : receives the terminal name, truncated or extended with C blanks as necessary. C LTERM : receives the number of characters in CTERM, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 1989-Nov-08 C----------------------------------------------------------------------- CTERM = 'CON' LTERM = 3 RETURN END C*GRTTER -- test whether device is user's terminal (MS-DOS) C+ SUBROUTINE GRTTER(CDEV, QSAME) CHARACTER CDEV*(*) LOGICAL QSAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C CDEV : (input) the device name to be tested. C QSAME : (output) .TRUE. is CDEV contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CTERM*64 INTEGER LTERM C CALL GRTRML(CTERM, LTERM) QSAME = (CDEV.EQ.CTERM(:LTERM)) RETURN END C*GRUSER -- get user name (MS-DOS) C+ SUBROUTINE GRUSER(CUSER, LUSER) CHARACTER CUSER*(*) INTEGER LUSER C C Return the name of the user running the program. C C Arguments: C CUSER : receives user name, truncated or extended with C blanks as necessary. C LUSER : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 1989-Mar-19 - [AFT] C----------------------------------------------------------------------- C CALL GRGENV('USER', CUSER, LUSER) RETURN END d another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 pgplot/sys_msdos/grexec.f010064400040640000322000000020160613655220000161770ustar00tjpcitmbr00000400000017C*GREXEC -- PGPLOT device handler dispatch routine C 12/93 C. T. Dum: version for MS F32 Power Station C+ SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR) INTEGER IDEV, IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C--- INTEGER NDEV PARAMETER (NDEV=7) CHARACTER*10 MSG C--- GOTO(1,2,3,4,5,6,7) IDEV IF (IDEV.EQ.0) THEN RBUF(1) = NDEV NBUF = 1 ELSE WRITE (MSG,'(I10)') IDEV CALL GRQUIT('Unknown device code in GREXEC: '//MSG) END IF RETURN C--- 1 CALL NUDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN 2 CALL MSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN 3 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) RETURN 4 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) RETURN 5 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,3) RETURN 6 CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,4) RETURN 7 CALL LXDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) RETURN C 8 CALL HJDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) C RETURN END pgplot/sys_msdos/grms1c.f010064400040640000322000000046460613655220000161310ustar00tjpcitmbr00000400000017 include 'flib.fi' INCLUDE 'FGRAPH.FI' SUBROUTINE GRMS1C( IX, IY, CHR, VID) INCLUDE 'FGRAPH.FD' RECORD /xycoord/ XY RECORD /VIDEOCONFIG/ VID INTEGER*2 IX, IY CHARACTER*(*) CHR C* cursor key input INTEGER*4 IMSIZE,INC,CNT(2),IERR INTEGER*2 X0, Y0, X1, Y1, DUMMY, ACTION, c IHR,IMIN,ISEC,ITICK INTEGER*1 SCAN, ICHR, BUFFER[ALLOCATABLE] (:) DATA ACTION/ $GPSET / C OVERKILL ON IMAGESIZE IN CASE THERE ARE BYTE ALLIGNMENT ISSUES IMSIZE = IMAGESIZE( 0,0,25,25 ) ALLOCATE( BUFFER( IMSIZE ), STAT = IERR ) IF( IERR .NE. 0 ) THEN DUMMY = SETVIDEOMODE( $DEFAULTMODE ) STOP 'Error: insufficient memory' ENDIF C COUNTER AND INCREMENT TO ADD CURSOR ACCELERATION CNT(1) = 0 INC = 1 ICHR = 0 DO WHILE(ICHR .EQ. 0) IX = MAX0( IX, 0) IY = MAX0( IY, 0) IX = MIN0( IX, (VID.NUMXPIXELS - 1)) IY = MIN0( IY, (VID.NUMYPIXELS - 1)) X0 = MAX0( (IX - 10), 0 ) Y0 = MAX0( (IY - 10), 0 ) X1 = MIN0( (IX + 10), (VID.NUMXPIXELS - 1)) Y1 = MIN0( (IY + 10), (VID.NUMYPIXELS - 1)) C SAVE IMAGE BELOW WHERE CURSOR WILL BE CALL GETIMAGE( X0, Y0, X1, Y1, BUFFER ) C NOW DRAW CURSOR CALL MOVETO( X0, IY, XY) DUMMY = LINETO( X1, IY) CALL MOVETO( IX, Y0, XY) DUMMY = LINETO( IX, Y1) CALL GETCH(ICHR,SCAN) C RESTORE IMAGE CALL PUTIMAGE( X0, Y0, BUFFER, ACTION ) C CALCULATE TIME PAST AND ACCELERATE IF NECESSARY CALL GETTIM(IHR,IMIN,ISEC,ITICK) CNT(2) = ITICK + 100*ISEC + 6000*IMIN IF ((CNT(2)-CNT(1)) .LT. 25) THEN INC = MIN0((INC + 1),30) ELSE INC = 1 ENDIF CNT(1) = CNT(2) IF(SCAN .EQ. #48) THEN IY = IY - INC ELSE IF (SCAN .EQ. #50) THEN IY = IY + INC ELSE IF(SCAN .EQ. #4D) THEN IX = IX + INC ELSE IF(SCAN .EQ. #4B) THEN IX = IX - INC ENDIF ENDDO DEALLOCATE( BUFFER ) CHR =CHAR(ICHR) RETURN END C------ SUBROUTINE GETCH(CHR,SCAN) include 'flib.fd' integer*1 chr,scan ctd 12/93 read keyboard, cursors character*1 result chr=#00 scan=#00 result=getcharqq() chr=ichar(result) if(chr.eq.#00)then result=getcharqq() scan=ichar(result) endif return end pgplot/sys_msdos/grms2m.f010064400040640000322000000016150614530244600161420ustar00tjpcitmbr00000400000017 INCLUDE 'FLIB.FI' !include if compiled separately INCLUDE 'FGRAPH.FI' INCLUDE 'MOUSE.FI' SUBROUTINE GRMS2M( IX, IY, CHR) INCLUDE 'FLIB.FD' INCLUDE 'FGRAPH.FD' INCLUDE 'MOUSE.FD' C* pos and return mouse cursor, return key pressed C C. T. Dum March 23,1995 c link with mouse.obj (FL32 distr.) RECORD /EVENT/ pEvent INTEGER*4 ichr INTEGER*2 IX, IY CHARACTER*(*) CHR ICHR = 0 c move mouse cursor, exit if key other than Function or Cursor is c pressed DO WHILE(ICHR .EQ. 0) call setptrpos(int4(ix),int4(iy)) call setptrvis(1) chr=getcharQQ() ichr=ichar(chr) if(ichr.eq.0) then c function or cursor key was pressed chr=getcharQQ() endif call getptrpos(pEvent) ix=pEvent.x iy=pEvent.y ENDDO call setptrvis(2) RETURN END *2 IX, IY CHARACTER*(*) CHR ICHR = 0 c move mouse cursor, exit if key other than Function or Cursor is pgplot/sys_msdos/grsy00.f010064400040640000322000000063210613655220000160510ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C----------------------------------------------------------------------- CHARACTER*(*) DEFNAM PARAMETER (DEFNAM='grfont.dat') INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END pgplot/sys_msdos/makefile010064400040640000322000000275230614527160400162730ustar00tjpcitmbr00000400000017# Makefile PGPLOT5.10 for use with Microsoft Power Station(FL32) # C. T. Dum, 12/93;7/94;3/95;5/95;4/96. # derived from AFT 91-Jun-27 # This generates the PGPLOT binary files (libraries and demos) in the # current default directory (which need not be the source directory). # # Directory containing source code SRC=C: SRCDIR=$(SRC)\pgl\src # Directory containing demo programs DEMODIR=$(SRC)\pgl\examples # Directory containing drivers DRVDIR=$(SRC)\pgl\drivers # Directory containing font stuff FONTDIR=$(SRC)\pgl\fonts # Directory containing system-dependent code SYSDIR=$(SRC)\pgl\sys_msdo # Directory to put the libraries LIBDIR=. # Fortran compiler FCOMPL=FL32 FFLAGC=/Op /nologo /G4 # C compiler CCOMPL= CFLAGC= # Libraries required for linking LIBS = PGPLOT.LIB # Rules for compiling Fortran .SUFFIXES: .F {$(SRCDIR)\}.F{}.OBJ: $(FCOMPL) /c $(FFLAGC) /Tf$< all: PGPLOT.LIB PGPACK.EXE PROG #----------------------------------------------------------------------- # Routine lists: # PG_ROUTINES: basic PGPLOT routines (Fortran-77) # PG_NON_STANDARD: non-Fortran-77 aliases for basic routines # GR_ROUTINES: support routines, not called directly by applications # (Fortran-77) # SYSTEM_ROUTINES: potentially non-portable routines, usually # operating-system dependent #----------------------------------------------------------------------- PGPLOT.LIB:: $(SRCDIR)\pgplot.inc $(SRCDIR)\grpckg1.inc REM PGPLOT.LIB:: pgask.obj pgbbuf.obj pgbeg.obj pgbin.obj pgbox.obj pgbox1.obj link32 -lib /out:pgplot.lib $? PGPLOT.LIB::pgcn01.obj pgcnsc.obj pgconb.obj pgcons.obj pgcont.obj pgconx.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgcp.obj pgcurs.obj pgdraw.obj pgebuf.obj pgend.obj pgenv.obj link32 -lib pgplot.lib $? PGPLOT.LIB::pgerrb.obj pgerrx.obj pgerry.obj pgetxt.obj pgfunt.obj pgfunx.obj link32 -lib pgplot.lib $? PGPLOT.LIB::pgfuny.obj pggray.obj pghi2d.obj pghis1.obj pghist.obj pgiden.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pglab.obj pglcur.obj pgldev.obj pglen.obj pgline.obj pgmove.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgmtxt.obj pgncur.obj pgnpl.obj pgnumb.obj pgolin.obj pgpage.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgpap.obj pgpixl.obj pgpnts.obj pgpoly.obj pgpt.obj pgptxt.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgqcf.obj pgqch.obj pgqci.obj pgqcol.obj pgqcr.obj pgqfs.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgqinf.obj pgqls.obj pgqlw.obj pgqpos.obj pgqvp.obj pgqwin.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgrect.obj pgrnd.obj pgrnge.obj pgscf.obj pgsch.obj pgsci.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgscr.obj pgsfs.obj pgshls.obj pgsls.obj pgslw.obj pgsvp.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgswin.obj pgtbox.obj pgtext.obj pgqtxt.obj pgqtbg.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgupdt.obj pgvsiz.obj pgvstd.obj pgvw.obj pgwnad.obj pgstbg.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgadvanc.obj pgbegin.obj pgcurse.obj pglabel.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgmtext.obj pgncurse.obj pgpaper.obj pgpoint.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgptext.obj pgvport.obj pgvsize.obj pgvstand.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgwindow.obj pgqcs.obj pgsubp.obj pgcl.obj pghtch.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgarro.obj pgsah.obj pgsave.obj pgscrn.obj pgqvsz.obj pgqhs.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgcirc.obj pgvect.obj pgqah.obj pgwedg.obj pgpanl.obj pgshs.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgscir.obj pgqcir.obj pgeras.obj pgconl.obj pgband.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgimag.obj pgctab.obj pgsitf.obj pgqitf.obj pgnoto.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: pgclos.obj pginit.obj pgopen.obj pgqid.obj pgslct.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grarea.obj grbpic.obj grchsz.obj grclip.obj grctoi.obj grmsg.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grclos.obj grclpl.obj grcurs.obj grdot0.obj grdtyp.obj grwarn.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: gresc.obj gretxt.obj grfa.obj grskpb.obj grepic.obj grpxps.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grgray.obj grqci.obj grqdev.obj grqdt.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grqfnt.obj grqcol.obj grqls.obj grqlw.obj grqpos.obj grqtyp.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grldev.obj grlen.obj grlin0.obj grlin1.obj grlin2.obj grlin3.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grlina.obj grmcur.obj grmker.obj grmova.obj gropen.obj grquit.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grpage.obj grpars.obj grrect.obj grscr.obj grslct.obj grqcap.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grsetc.obj grsci.obj grsfnt.obj grsls.obj grslw.obj grqtxt.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grsets.obj grsize.obj grsyds.obj grsymk.obj grsyxd.obj grprom.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grterm.obj grtext.obj grtoup.obj grtrn0.obj grtxy0.obj grtrim.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grvct0.obj grxhls.obj grxrgb.obj grpixl.obj grgfil.obj grinit.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grpxpo.obj grpxpx.obj grpxre.obj grrec0.obj grfao.obj gritoc.obj link32 -lib pgplot.lib $? PGPLOT.LIB:: grpocl.obj grqcr.obj grimg0.obj grimg1.obj grimg2.obj grimg3.obj link32 -lib pgplot.lib $? # DOS PGPLOT.LIB:: grsy00.obj grexec.obj grdos.obj msdriv.obj grms1c.obj grms2m.obj link32 -lib pgplot.lib $? grsy00.obj : $(SYSDIR)\grsy00.f $(FCOMPL) /c $(FFLAGC) /Tf$(SYSDIR)\grsy00.f grexec.obj : $(SYSDIR)\grexec.f $(FCOMPL) /c $(FFLAGC) /Tf$(SYSDIR)\grexec.f grdos.obj : $(SYSDIR)\grdos.f $(FCOMPL) /c $(FFLAGC) /Tf$(SYSDIR)\grdos.f msdriv.obj : $(SYSDIR)\msdriv.f $(FCOMPL) /c $(FFLAGC) /Tf$(SYSDIR)\msdriv.f grms1c.obj : $(SYSDIR)\grms1c.f $(FCOMPL) /c /Tf$(SYSDIR)\grms1c.f grms2m.obj : $(SYSDIR)\grms2m.f $(FCOMPL) /c /Tf$(SYSDIR)\grms2m.f PGPLOT.LIB:: link32 -lib pgplot.lib mouse.obj #----------------------------------------------------------------------- # Device drivers # Compile drivers that compile under Microsoft Fortran. # ctd : need to modify rules for finding /drivers or simply copy into /src PGPLOT.LIB:: nudriv.obj psdriv.obj lxdriv.obj #hjdriv.obj link32 -lib pgplot.lib $? nudriv.obj : $(DRVDIR)\nudriv.f $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\nudriv.f psdriv.obj : $(DRVDIR)\psdriv.f $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\psdriv.f #hjdriv.obj : $(DRVDIR)\hjdriv.f # $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\hjdriv.f #gidriv.obj : $(DRVDIR)\gidriv.f # $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\gidriv.f #ttdriv.obj : $(DRVDIR)\ttdriv.f grcter groter grpter grwter missing # $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\ttdriv.f lxdriv.obj : $(DRVDIR)\lxdriv.f $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\lxdriv.f #ljdriv.obj : $(DRVDIR)\ljdriv.f # $(FCOMPL) /c $(FFLAGC) /Tf$(DRVDIR)\ljdriv.f #----------------------------------------------------------------------- # Target "lib" is used to built the PGPLOT subroutine library. # libpgplot.a is the primary PGPLOT library. #----------------------------------------------------------------------- lib : PGPLOT.LIB #----------------------------------------------------------------------- # libpgobs.a contains obsolete routines used by some programs #----------------------------------------------------------------------- #OBSOLETE_ROUTINES=\ # grchar.obj grchr0.obj grdat2.obj grgtc0.obj grmark.obj grinqli.obj\ # grinqpen.obj\ # grsetli.obj grsetpen.obj grlinr.obj grmovr.obj grtran.obj grvect.obj\ # pgsetc.obj pgsize.obj grinqfon.obj grsetfon.obj # #PGOBS.LIB : $(OBSOLETE_ROUTINES) # link32 -lib PGOBS.LIB $? # #----------------------------------------------------------------------- # Target "prog" is used to make the demo programs. They can also be made # individually. #----------------------------------------------------------------------- # List of demo programs DEMOS = pgdemo1.exe pgdemo2.exe pgdemo3.exe pgdemo4.exe pgdemo5.exe \ pgdemo6.exe pgdemo7.exe pgdemo8.exe pgdemo9.exe pgdemo10.exe \ pgdemo11.exe pgdemo12.exe pgdemo13.exe pgdemo14.exe prog: $(DEMOS) pgdemo1.exe: $(DEMODIR)\pgdemo1.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo1.f $(LIBS) pgdemo2.exe: $(DEMODIR)\pgdemo2.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo2.F $(LIBS) pgdemo3.exe: $(DEMODIR)\pgdemo3.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo3.F $(LIBS) pgdemo4.exe: $(DEMODIR)\pgdemo4.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo4.F $(LIBS) pgdemo5.exe: $(DEMODIR)\pgdemo5.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo5.F $(LIBS) pgdemo6.exe: $(DEMODIR)\pgdemo6.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo6.F $(LIBS) pgdemo7.exe: $(DEMODIR)\pgdemo7.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo7.F $(LIBS) pgdemo8.exe: $(DEMODIR)\pgdemo8.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo8.F $(LIBS) pgdemo9.exe: $(DEMODIR)\pgdemo9.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo9.F $(LIBS) pgdemo10.exe: $(DEMODIR)\pgdemo10.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo10.F $(LIBS) pgdemo11.exe: $(DEMODIR)\pgdemo11.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo11.F $(LIBS) pgdemo12.exe: $(DEMODIR)\pgdemo12.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo12.F $(LIBS) pgdemo13.exe: $(DEMODIR)\pgdemo13.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo13.F $(LIBS) pgdemo14.exe: $(DEMODIR)\pgdemo14.f $(FCOMPL) $(FFLAGC) /Tf$(DEMODIR)\pgdemo14.F $(LIBS) #----------------------------------------------------------------------- # Target "grfont.dat" is the binary font file. # This is created from grfont.txt with the "pgpack" program. # (a) compile the `pgpack' program; then # (b) run `pgpack' to convert the ASCII version of the font file # (grfont.txt) into the binary version (grfont.dat). When executed, # `pgpack' should report: # Characters defined: 996 # Array cells used: 26732 #----------------------------------------------------------------------- pgpack.exe: $(FONTDIR)\pgpack.f $(FCOMPL) $(FFLAGC) /Tf$(FONTDIR)\pgpack.f # #grfont.dat: $(FONTDIR)\grfont.txt pgpack.exe # DEL grfont.dat # pgpack < $(FONTDIR)\grfont.txt # problem with dos extender: run outside nmake,note program name:pack #----------------------------------------------------------------------- # Target "install" is required for Figaro. #----------------------------------------------------------------------- install: #----------------------------------------------------------------------- # Target "clean" is used to remove all the intermediate files. #----------------------------------------------------------------------- clean : DEL *.OBJ DEL *.FOR DEL PGPLOT.BAK DEL PGPACK.EXE DEL PGPLOT.INC DEL GRPCKG1.INC SPOTLESS: CLEAN DEL *.EXE DEL GRFONT.DAT DEL PGPLOT.LIB # Include file dependencies: # The following PG routines reference `pgplot.inc' grgray.o grgrgr.o pgask.o pgbbuf.o pgbeg.o pgbin.o pgbox.o \ pgcont.o pgcp.o pgcurs.o pgebuf.o pgend.o pgerrb.o pgerrx.o pgerry.o pgscir.o\ pggray.o pghi2d.o pghist.o pgiden.o pglcur.o pglen.o pgmtxt.o pgncur.o pgsitf.o\ pgolin.o pgpage.o pgpap.o pgpixl.o pgpoly.o pgpt.o pgptxt.o pgqah.o \ pgqch.o pgqcs.o pgqfs.o pgqinf.o pgqvsz.o pgqtbg.o pgqvp.o pgqwin.o \ pgrect.o pgsah.o pgsch.o pgsfs.o pgstbg.o pgsubp.o pgsvp.o pgswin.o \ pgband.o pgcl.o pgconl.o pgimag.o pgnoto.o pgcirc.o pgqitf.o pgqtxt.o \ pgupdt.o pgvsiz.o pgvstd.o pgvw.o pgwedg.o pgwnad.o: $(SRC)/pgplot.inc # The following GR routines reference `grpckg.inc' grarea.o grbpic.o grchr0.o grchsz.o grclos.o grclpl.o grcurs.o grepic.o\ grdot0.o grdtyp.o gresc.o gretxt.o grfa.o grgray.o grgrgr.o grqcr.o \ grldev.o grlen.o grlin0.o grlin1.o grlin2.o grlin3.o grqcap.o grqtxt.o \ grlina.o grlinr.o grmker.o grmova.o grmovr.o gropen.o grpage.o \ grpixl.o grpxpo.o grpxpx.o grimg0.o grimg1.o grimg2.o grimg3.o \ grqci.o grqcol.o grqdev.o grqdt.o grqfnt.o grqls.o grpxps.o \ grqlw.o grqpos.o grqtyp.o grrec0.o grrect.o \ grsci.o grscr.o grsetc.o grsetli.o grsets.o grsfnt.o grsfs.o grsize.o \ grslct.o grsls.o grslw.o grterm.o grtext.o grtrn0.o grtxy0.o \ grvct0.o: $(SRC)/grpckg1.inc griv00.o : $(SRCDIR)/gadef.h $(SRCDIR)/gmdef.h $(SRCDIR)/gphdef.h grtv00.o : $(SRCDIR)/imdef.h pgplot/sys_msdos/msdriv.f010064400040640000322000000315540614530312600162400ustar00tjpcitmbr00000400000017 INCLUDE 'FGRAPH.FI' INCLUDE 'FLIB.FI' INCLUDE 'MOUSE.FI' C*MSDRIV -- PGPLOT device driver for MS-DOS machines C+ SUBROUTINE MSDRIV (IFUNC, RBUF, NBUF, CHR, LCHR) C IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR INCLUDE 'FGRAPH.FD' C C PGPLOT driver for IBM PC's and clones running Microsoft Fortran 32 C This driver will put the display into graphics mode. PGEND will C return the monitor to the default (text) mode after pressing enter. C C This routine must be compiled and linked with the Microsoft graphics C library supplied with Microsoft Fortran 32 or greater. C The mouse routines grms1m, grms2m also require linking with mouse.obj C 1989-Nov-03 - Started work [AFT] C 1989-Apr-06 - Improved version [AFT] C 1991-Mar-13 - Added cursor routine [JHT] C 12/1993 C. T. Dum: Version for MS Fortran Power Station C 3/95 C. T. Dum: mouse routine added C----------------------------------------------------------------------- C C Supported device: IBM PC's and compatibles C C Device type code: /MSOFT C C Default device name: None (the device name, if specified, is C ignored). C C Default view surface dimensions: Depends on monitor, typical 7x10 inches C C Resolution: Depends on graphics card. Tested with a SVGA(TSENG C ET4000, V7-Mercury P-64V)Card. The high resolution modes SRES C (800*600), XRES(1024*768) and ZRES(1280*1024) require a VESA compliant C SVGA card or an additional VESA TSR. C Warning! Use the SRES, XRES, and ZRES modes only if they are C supported by graphics card and monitor, else damage may result! C Color capability: Color indices 0-15 are accepted. This version maps C the PGPLOT color indices into the IBM color indices for with the C default color most closely corresponds to the PGPLOT default color. C Thus, PGPLOT index 2 (red) maps to IBM index 12 (light red). C The Default mode is VGA16 with 640*480 resolution. Higher resolution C modes are accessed by entering SET PGPLOT_VIDEO=SGA16, or XGA16, ZGA16 C on the DOS command line, before starting programs. C No mapping is performed in the 256 color modes. These modes are accessed C by SET PGPLOT_VIDEO=VGA25 or SGA25, XGA25, ZGA25. C Input capability: None. C File format: None. C Obtaining hardcopy: Not possible. C----------------------------------------------------------------------- RECORD /VIDEOCONFIG/ VID RECORD /XYCOORD/ XY C CHARACTER CMSG*10 INTEGER LEVEL, MXX, MXY REAL A,B INTEGER*2 I2TAB(0:15) INTEGER*2 I2BLU, I2GRN, I2IND, I2PEND, I2RED INTEGER*2 I2STAT, I2TMP, I2X0, I2Y0, I2X1, I2Y1 INTEGER*4 I4STAT LOGICAL QFIRST SAVE QFIRST, MXX, MXY DATA I2TAB/ 0,15,12,10, 9,11,13,14, 6, 2, 3, 1, 5, 4, 8, 7/ DATA QFIRST/.TRUE./ C C--- GOTO( 10, 20, 30, 40, 50, 60, 70, 80, 90,100, 1 110,120,130,140,150,160,170,180,190,200, 2 210,220,230,240,250,260) IFUNC 900 WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in MSOFT device driver: '/ : /CMSG) NBUF = -1 RETURN C C--- IFUNC = 1, Return device name.------------------------------------- C 10 CHR = 'MSOFT' LCHR = 5 RETURN C C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- C 20 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0. RBUF(2) = FLOAT(MXX) RBUF(3) = 0. RBUF(4) = FLOAT(MXY) RBUF(5) = 0. RBUF(6) = VID.NUMCOLORS-1 NBUF = 6 RETURN C C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. C 30 continue IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) A = FLOAT(MXX)/10.0 RBUF(1) = A B = FLOAT(MXY)/7.0 RBUF(2) = B RBUF(3) = 1.0 NBUF = 3 RETURN C C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, cursor, No dashed lines, No area fill, C No thick lines, No rectangle fill) C 40 CHR = 'ICNNNNNNNN' LCHR = 10 RETURN C C--- IFUNC = 5, Return default file name. ------------------------------ C 50 CHR = ' ' LCHR = 1 RETURN C C--- IFUNC = 6, Return default physical size of plot. ------------------ C 60 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0. RBUF(2) = FLOAT(MXX) RBUF(3) = 0. RBUF(4) = FLOAT(MXY) NBUF = 4 RETURN C C--- IFUNC = 7, Return misc defaults. ---------------------------------- C 70 RBUF(1) = 1. NBUF = 1 RETURN C C--- IFUNC = 8, Select plot. ------------------------------------------- C 80 CONTINUE RETURN C C--- IFUNC = 9, Open workstation. -------------------------------------- C 90 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) RBUF(1) = 0. RBUF(2) = 1. NBUF = 2 IF(RBUF(3).NE.0.) THEN I2PEND=1 ELSE I2PEND=0 END IF RETURN C C--- IFUNC=10, Close workstation. -------------------------------------- C 100 CONTINUE read(*,*) ! press enter to end graphics mode I2STAT = SETVIDEOMODE( $DEFAULTMODE ) QFIRST=.TRUE. RETURN C C--- IFUNC=11, Begin picture. ------------------------------------------ C 110 CONTINUE IF(QFIRST) CALL GRMS00(VID, MXX, MXY, QFIRST) IF(I2PEND.EQ.0) THEN CALL CLEARSCREEN($GCLEARSCREEN) END IF I2PEND=0 RETURN C C--- IFUNC=12, Draw line. ---------------------------------------------- C 120 CONTINUE I2X0=NINT(RBUF(1)) I2Y0=MXY-NINT(RBUF(2)) CALL MOVETO(I2X0, I2Y0, XY) I2X1=NINT(RBUF(3)) I2Y1=MXY-NINT(RBUF(4)) I2STAT=LINETO(I2X1, I2Y1) RETURN C C--- IFUNC=13, Draw dot. ----------------------------------------------- C 130 CONTINUE I2X0=NINT(RBUF(1)) I2Y0=MXY-NINT(RBUF(2)) I2STAT=SETPIXEL(I2X0, I2Y0) RETURN C C--- IFUNC=14, End picture. -------------------------------------------- C 140 CONTINUE RETURN C C--- IFUNC=15, Select color index. ------------------------------------- 150 CONTINUE I2TMP=MAX(0,NINT(RBUF(1))) IF(I2TMP.LT.16)then I2IND=I2TAB(I2TMP) ELSE I2IND=I2TMP ENDIF I2STAT=SETCOLOR(I2IND) RETURN C C--- IFUNC=16, Flush buffer. ------------------------------------------- C 160 CONTINUE RETURN C C--- IFUNC=17, Read cursor or mouse -------------------------------------------- C C 170 CONTINUE I2X0 = NINT(RBUF(1)) I2Y0 = MXY-NINT(RBUF(2)) IF(VID.MODE .EQ. $VRES16COLOR)THEN ctd CALL GRMS1M( I2X0, I2Y0, CHR) ! mouse routine for VGA16, chars ctd assigned to buttons CALL GRMS2M( I2X0, I2Y0, CHR) ! mouse routine for VGA16, waits ctd for keyboard input ELSE CALL GRMS1C( I2X0, I2Y0, CHR, VID) ! cursor routine ENDIF RBUF(1) = FLOAT(I2X0) RBUF(2) = FLOAT(MXY-I2Y0) NBUF = 2 LCHR = 1 RETURN C C--- IFUNC=18, Erase alpha screen. ------------------------------------- C 180 CONTINUE RETURN C C--- IFUNC=19, Set line style. ----------------------------------------- C 190 CONTINUE RETURN C C--- IFUNC=20, Polygon fill. ------------------------------------------- C 200 CONTINUE RETURN C C--- IFUNC=21, Set color representation. ------------------------------- C 210 CONTINUE I2TMP=MAX(0,NINT(RBUF(1))) IF(I2TMP.LT.16)then I2IND=I2TAB(I2TMP) ELSE I2IND=I2TMP ENDIF IF(VID.NUMCOLORS.EQ.16) THEN C EGA 16 color mode I2RED=INT(RBUF(2)*3.999) I2GRN=INT(RBUF(3)*3.999) I2BLU=INT(RBUF(4)*3.999) LEVEL=(#303030.AND.(ISHFT(I2BLU,20).OR.ISHFT(I2GRN,12).OR. : ISHFT(I2RED,4))) I4STAT=REMAPPALETTE(I2IND,LEVEL) ELSE IF(VID.NUMCOLORS.EQ.256) THEN C VGA 256 color mode I2RED=INT(RBUF(2)*63.999) I2GRN=INT(RBUF(3)*63.999) I2BLU=INT(RBUF(4)*63.999) LEVEL=(#3F3F3F.AND.(ISHFT(I2BLU,16).OR.ISHFT(I2GRN,8).OR. : I2RED)) I4STAT=REMAPPALETTE(I2IND,LEVEL) END IF RETURN C C--- IFUNC=22, Set line width. ----------------------------------------- C 220 CONTINUE RETURN C C--- IFUNC=23, Escape. ------------------------------------------------- C 230 CONTINUE RETURN C C--- IFUNC=24, Rectangle fill. ----------------------------------------- C 240 CONTINUE RETURN C C--- IFUNC=25, Set fill pattern. --------------------------------------- C 250 CONTINUE RETURN C C--- IFUNC=26, Line of pixels. ----------------------------------------- C 260 CONTINUE RETURN C----------------------------------------------------------------------- END C********* SUBROUTINE GRMS00(VID, MXX, MXY, QFIRST) INCLUDE 'FGRAPH.FD' RECORD /VIDEOCONFIG/ VID INTEGER MXX, MXY ,TR$L LOGICAL QFIRST C--- INTEGER*2 I2STAT C added parameter override of default configuration... JHT 23-Feb-1991 character*128 TR$VID C--- QFIRST=.FALSE. CALL GRGENV('VIDEO', TR$VID, TR$L) IF (TR$L .EQ. 0) THEN CALL GETVIDEOCONFIG(VID) ctd IF(VID.ADAPTER.EQ.$CGA) THEN ctd I2STAT=SETVIDEOMODE($HRESBW) ctd ELSE IF(VID.ADAPTER.EQ.$OCGA) THEN ctd I2STAT=SETVIDEOMODE($ORESCOLOR) IF(VID.ADAPTER.EQ.$EGA .OR. VID.ADAPTER.EQ.$OEGA) THEN IF(VID.MONITOR .EQ. $MONO) THEN I2STAT=SETVIDEOMODE($ERESNOCOLOR) ELSE I2STAT=SETVIDEOMODE($ERESCOLOR) END IF ELSE IF(VID.ADAPTER.EQ.$VGA .OR. VID.ADAPTER.EQ.$OVGA) THEN ctd : .OR. VID.ADAPTER.EQ.$MCGA) THEN ctd no longer supported IF(VID.MONITOR .EQ. $MONO) THEN I2STAT=SETVIDEOMODE($VRES2COLOR) ELSE I2STAT=SETVIDEOMODE($VRES16COLOR) END IF ctd ELSE IF(VID.ADAPTER.EQ.$HGC) THEN ctd I2STAT=SETVIDEOMODE($HERCMONO) ELSE IF(VID.ADAPTER.EQ.$SVGA) THEN IF(VID.MONITOR .EQ. $MONO) THEN I2STAT=SETVIDEOMODE($VRES2COLOR) ELSE I2STAT=SETVIDEOMODE($VRES16COLOR) END IF ELSE WRITE(*,*) 'Unknown graphics adapter.' STOP END IF ELSE IF(TR$VID(:TR$L) .EQ. 'EGA16') THEN I2STAT=SETVIDEOMODE($ERESCOLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'VGA16') THEN I2STAT=SETVIDEOMODE($VRES16COLOR) ctd warning (MS): careful possibly monitor damage with S,X,Z modes ELSE IF(TR$VID(:TR$L) .EQ. 'VGA25') THEN I2STAT=SETVIDEOMODE($VRES256COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'SGA16') THEN I2STAT=SETVIDEOMODE($SRES16COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'SGA25') THEN I2STAT=SETVIDEOMODE($SRES256COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'XGA16') THEN I2STAT=SETVIDEOMODE($XRES16COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'XGA25') THEN I2STAT=SETVIDEOMODE($XRES256COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'ZGA16') THEN I2STAT=SETVIDEOMODE($ZRES16COLOR) ELSE IF(TR$VID(:TR$L) .EQ. 'ZGA25') THEN I2STAT=SETVIDEOMODE($ZRES256COLOR) else I2STAT=SETVIDEOMODE($MAXRESMODE) END IF END IF CALL GETVIDEOCONFIG(VID) MXX=VID.NUMXPIXELS-1 MXY=VID.NUMYPIXELS-1 RETURN END C------ SUBROUTINE GRMS1M( IX, IY, CHR) INCLUDE 'FLIB.FD' INCLUDE 'FGRAPH.FD' INCLUDE 'MOUSE.FD' INTEGER*2 IX, IY CHARACTER*(*) CHR C* pos. and return mouse cursor C IX, IY coordinates (I/O) C CHR (O) A,X,D or CTRL-D (EOT) C C. T. Dum, March 23,1995 C link with mouse.obj (FL32 distr.), works for vga16 only C left button returns A for single click, X for 2 clicks within 1s C right button returns D for single click CTRL D for 2 clicks within 1s C link with mouse.obj (FL32 distr.), works for vga16 only RECORD /BTN_STS/ btns INTEGER*4 ip,ICHR ICHR = 0 ip=0 c move mouse cursor, exit if button is pressed DO WHILE(ICHR .EQ. 0) call setptrpos(int4(ix),int4(iy)) call setptrvis(1) do while(ip.eq.0) btns.Btn=1 ! right button ip=getbuttonpress(btns) c could add middle button (btns.Btn=2) if exists, or left & right if(ip.gt.0)then ix=btns.x iy=btns.y chr='D' if(ip.eq.2) chr=char(4) ichr=ichar(chr) else btns.Btn=0 ! left button ip=getbuttonpress(btns) if(ip.gt.0)then ix=btns.x iy=btns.y chr='A' if(ip.eq.2) chr='X' ichr=ichar(chr) else c wait 1sec call sleepqq(1000) endif endif enddo ENDDO call setptrvis(2) RETURN END 190,200, 2 210,220,230,240,250,260) IFUNC 900 WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in MSOFT device drivepgplot/sys_msdos/aaaread.me010064400040640000322000000256510614531102200164610ustar00tjpcitmbr00000400000017 PGPLOT 5.10 for MS Power Station 1.0A (FL32) C. T. Dum, May 1996 The following notes describe the porting of Tim Pearson's PGPLOT 5.10 to the Microsoft Power Station for 32 bit Fortran. This compiler is very easy to use, but most importantly removes the severe memory restrictions of 16bit Fortran. Rather large applications can thus be linked with PGPLOT.LIB. The FL32 Library also includes many additional (system) functions known from C. Once PGPLOT.LIB is built applications are most easily compiled using the Programmers workbench under Windows. (Programs, however, are executed in a DOS window.) The steps in building PGPLOT.LIB are the following: 1. Download PGPLOT5.10.TAR.Z Uncompress and De-Tar as usual (There are also Dos Versions of these programs) or download files from a UNIX machine. It is not necessary to change files from UNIX LF termination of lines to DOS CR-LF. (A ZIP archive is also available 2. Create the subdirectory structure corresponding to the tar file in the directory of your choice ( in my case c:\pgl) Eliminate unneeded subdirectories (see Makefile), e.g. pgdisp and various sys subdirectories. 3. F32\include\FGRAPH.FD (MS distribution) add declaration of $GRTEXTNOTSUPPORTED as INTEGER*2 (MS bug) 4. Place MAKEFILE (for FL32) in your chosen directory (c:\pgl)and modify directory names if applicable. DOS supports only names with up to 8 characters, thus the directory for the DOS files becomes sys_msdo and pgadvance.f in \src must be shortened to pgadvanc.f. MAKEFILE has been derived from Tennant's version. Copying of files from the .F extension to the .FOR extension is avoided by using the lag /Tf in FL32. The flag /Fo could be used to replace the default extension .obj of the output by .o 5. Drivers for the Screen (vga), Postscript, LaTeX, and the Null driver have been included. The SVGA (resolution 800*600), X modes (1024*768) and Z modes (1278*1024) modes with 16 or 256 colors require a VESA compliant video card or a corresponding TSR (some are included in the FL32 distribution). By default the 16 color mode (vga16) or B/W for mono monitors is implemented by msdriv.for. Other modes can be set with the environment variable PGPLOT_VIDEO (e.g. SET PGPLOT_VIDEO=VGA25, or SGA16, SGA25, XGA16, XGA25, ZGA16, ZGA25). For these modes make sure, however, that they are supported by your video card and monitor, else damage may result.!! MSDRIV.F has been modified such that PGEND now returns the screen to the default video mode (text mode) after pressing ENTER. Issuing MODE CO80 from the DOS command line thus is no longer necessary for returning to the text mode. The default device can be set with PGPLOT_DEV (e.g. /MS). The /NULL, /LATEX and /PS drivers have also been enabled. The /HJ driver contains a PC version (commented out). It works for the most part with a HP laserjet. However, Pgdemo7,8 produce several extra formfeeds. If you add additional drivers (the may require changes for FL32 to eliminate syntax errors, VAX extensions etc.) to the library then grexec.f must also be modified to reflect this changes, in particular ndev must reflect the total number of drivers. The cursor routine has been extracted from the file MSDRIV.F and was placed in a separate file GRMS1C.F. Using a mouse in place of the cursor keys, e.g. in pgdemo5, 6, requires an appropriate TSR (in addition to the mouse driver) which simulates cursor input. Software accompanying the mouse may contain such programs. The cursor routine can also be extended by Assembler or C code using DOS interrupt 0x33 for the mouse. (This interrupt is enabled by the mouse driver). Such code, based upon the .asm program in the directory \samples\graphics\demo of the FL32 distribution, is included in MSDRIV.FOR. It apparently works only for VGA16 mode (or mono?). Therefore MSDRIV.F switches to cursor input for other graphics modes. Use of this mouse routine requires that MOUSE.OBJ from the FL32 distribution (in \samples\graphics\demo) is linked (added to PGPLOT.LIB). The left mouse button inputs 'A' for a single click, X for a double click (within 1 sec). The right mouse button inputs 'D' and 'CTRL-D' respectively. These assigments can easily be changed or augmented for a middle button or 2 button input. Subroutine GRMS1M in MSDRIV.F can be replaced by GRMS2M.F which waits for keyboard input instead of mouse clicks. If you use the cursor keys only, or figure out how to extend the mouse routine to SVGA modes the switch between cursor routines in subroutine GRMS00 of MSDRIV.F can be eliminated. MAKEFILE by default is configured for using the mouse with GRMS1M. For cursor input only linking of mouse.obj is not needed, else place MOUSE.OBJ into the PGPLOT_DIR. Also place the include files mouse.fi, mouse.fd into the directory f32\include. 6. Under DOS (not windows) say nmake. It will take a while to generate some 221 .obj files, PGPLOT.LIB, PGPACK.EXE and the 12 exes for the examples. Unless you immediately plan modifications, the .obj files can be then be deleted, of course. The execution of PGPACK with generates grfont.dat from grfont.txt does not work within NMAKE, as different DOS extender versions are used. Run PGPACK < path\grfont.txt outside nmake. 7. If a source file is modified remove the old file.obj file from the lib with link32 -lib pgplot.lib /remove:file.obj before issuing nmake again. A new module can also be generated with fl32 /c new.for and added to pgplot.lib with link32 -lib pgplot.lib new.obj. A demo.exe can be generated with fl32 demo.for pgplot.lib or fl32 /Tfpath\demo.f pgplot.lib. 8. The compiler option with optimization /Op is used in the MAKEFILE. It has been found that the cursor routine (GRMS1C) works incorrectly (coordinates are modified when the background image is saved!) if compiled with this option and a SVGA mode is used. The switch from version 1.0 of FL32 to version 1.0A (bug fixes, new dos extender) also required minor changes (in grsy00.for, grgfil.for) in order to avoid crashes (protection faults, heap errors). This dependence on functionally equivalent statements (block ifs instead of if, or addition of print statements) is due to compiler bugs. (see below). 9. A list of all the modules in PGPLOT.LIB can be generated with link32 -lib pgplot.lib /list > pgplot.lst 10.Finally, this port has been thoroughly tested (starting with earlier versions of PGPLOT), but no responsibility for any damages is accepted! 11. TODO: update and port of printer drivers, mouse routine for SVGA, C binding (According to MS, combining C/C++ with Fortran requires the 32 bit version of Visual C/C++.). 12. Notes on version 5.10 PGOPEN now allows the use of several output devices, as shown in PGDEMO13. It can be used here e.g. for the simultaneous generation of screen output and Postscript files. As this DOS version does not have separate windows for text and graphics, text output (from print statements) will overwrite graphics or become invisible after a switch to a high resolution display mode. It is thus recommended to specify the screen mode as the last device, i.e. the menu in the this example. pgdemo14 requires keyboard input in addition to mouse/cursor input. msdriv.f thus has been modified to call mouse routine grms2m instead of grms1m. As described above grms1m allows only fixed input assigned to the buttons. If there is extra mouse/cursor input, e.g. outside the menu buttons in pgdemo13, a runtime error R6001 (null pointer assignment) is reported, but is harmless. Appendix: The Microsoft Fortran compiler fails to compile some subroutines correctly. As far as possible, these problems have been circumvented in the PGPLOT code, but some problems may remain. According to Microsoft, bad code is generated, and a run-time unexpected heap error occurs under the following circumstances: 1. There is an if statement alone, not a block if. 2. There is a call to a subroutine that takes a character argument in the IF block 3. The actual argument passed to the subroutine is a character expression that includes concatenation of characters 4. The IF expression is evaluated as False so that the call is not carried out. "Subroutines" includes intrinsics such as PRINT and write. The cure is to use either block if or to assign character expressions to a temporary variable rather than passing it directly. ________________________________________________________________________ ***Usage with Windows 95******* There is a newer version, PowerStation 4.0, which is designed for Windows 95/Windows NT. An implementation by P. A. Seeger has just been added to this disatribution (sys_win). However, the current version can also be run under Windows 95 if a patch fpsfix95.exe (available from a Microsoft BBS) is installed as described by the following MS readme file: Microsoft FORTRAN PowerStation for MS-DOS/Windows Fix for Windows 95 ******************************************************************** Microsoft FORTRAN PowerStation for MS-DOS and Windows is designed to work optimally with Microsoft Windows 3.1. When used with Windows 95, there is a problem with graphics programs and a simple work-around is described here. Microsoft FORTRAN PowerStation 1.0a =================================== First, you should be using the maintenance release of Microsoft FORTRAN PowerStation. To tell if you are using 1.0a, run "link.exe" from the bin directory. You should see "Version 1.0F"; look for the "F". If it is there, you have 1.0a. If not, please contact Microsoft support services at the number listed in your documentation for where you live. If you live in the United States or Canada, call 206-635-7015. Installing The Fix ================== Run the setup.bat batch file included with this package. Executables built with this fix in place can still be used on MS-DOS and Windows 3.1 systems. Problem Corrected: ================== Graphics Programs Fail ---------------------- Graphics programs compiled with FORTRAN PowerStation fail when run. Instead of the usual graphics output, you will instead see a runtime error. The cause of this problem is that Windows 95 is running the graphics program as a true Win32 program, instead of as a DOS-extended program. >From a console Win32 program graphics are not supported, so the program fails. The program 'fpsfix' marks the executable so that Windows 95 will treat it as a DOS program, and not a Win32 program. Setup.bat will install fpsfix so that all programs compiled will automatically be fpsfix'ed. If you have any graphics programs that were previously compiled, you can run fpsfix by hand on these by running: fpsfix exename.exe where exename.exe is the name of your executable. ------------------------------------------------------------------------- modes (1024*768) and Z modes (1278*1024) modes with 16 or 256 colors require a VESApgplot/sys_next/af77_src/x2wrap.c010064400040640000322000000007140567152653700174320ustar00tjpcitmbr00000400000017void x2driv_(); /* * This is a wrapper function used to call the /xdisp driver from * Absoft FORTRAN (NeXT). *-- * 13-Nov-1994 - [mcs] */ void X2DRIV(ifunc, rbuf, nbuf, chr, lchr, mode, w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode) int *ifunc; float *rbuf; int *nbuf; char *chr; int *lchr; int w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode; /* Argument widths */ { x2driv_(ifunc, rbuf, nbuf, chr, lchr, mode, w_chr); return; } pgplot/sys_next/af77_src/xwwrap.c010064400040640000322000000007160567214741600175350ustar00tjpcitmbr00000400000017void xwdriv_(); /* * This is a wrapper function used to call the /xwindow driver from * Absoft FORTRAN (NeXT). *-- * 13-Nov-1994 - [mcs] */ void XWDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode) int *ifunc; float *rbuf; int *nbuf; char *chr; int *lchr; int w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode; /* Argument widths */ { xwdriv_(ifunc, rbuf, nbuf, chr, lchr, mode, w_chr); return; } pgplot/sys_next/af77_src/grdate.c010064400040640000322000000033600567152653700174550ustar00tjpcitmbr00000400000017#include #include /**GRDATE -- get date and time as character string (Cray) *+ * SUBROUTINE GRDATE(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. * To receive the whole string, the STRING should be declared * CHARACTER*17. * * Arguments: * STRING : receives date and time, truncated or extended with * blanks as necessary. * SLEN : receives the number of characters in STRING, excluding * trailing blanks. This will always be 17, unless the length * of the string supplied is shorter. *-- * 13-Nov-1994 - [mcs] Abosft FORTRAN callable C version for NeXT. *----------------------------------------------------------------------- */ void GRDATE(string, slen, maxlen, w_slen) char *string; int *slen; int maxlen, w_slen; { char vtime[18]; /* Output string compilation buffer */ char *utime; /* Returned string from ctime() */ time_t x; /* Time returned by time() */ int i; /* * Get the standard C time string. */ time(&x); utime = ctime(&x); /* * Copy a re-organised version of the time string into vtime[]. */ vtime[0] = utime[8]; vtime[1] = utime[9]; vtime[2] = '-'; vtime[3] = utime[4]; vtime[4] = utime[5]; vtime[5] = utime[6]; vtime[6] = '-'; vtime[7] = utime[20]; vtime[8] = utime[21]; vtime[9] = utime[22]; vtime[10] = utime[23]; vtime[11] = ' '; strncpy(vtime+12, utime+11, 5); vtime[17]='\0'; /* * Copy up to maxlen characters of vtime into the output FORTRAN string. */ strncpy(string, vtime, maxlen); *slen = (maxlen < 17) ? maxlen : 17; /* * Pad the FORTRAN string with spaces. */ for(i=17; i #include /* **GRGENV -- get value of PGPLOT environment parameter (Next) *+ * SUBROUTINE GRGENV(NAME, VALUE, L) * CHARACTER*(*) NAME, VALUE * INTEGER L * * Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, * environment parameters are UNIX environment variables; e.g. parameter * ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not * recursive and is case-sensitive. * * Arguments: * NAME : (input) the name of the parameter to evaluate. * VALUE : receives the value of the parameter, truncated or extended * with blanks as necessary. If the parameter is undefined, * a blank string is returned. * L : receives the number of characters in VALUE, excluding * trailing blanks. If the parameter is undefined, zero is * returned. *-- * 13-Nov-1994 - [mcs] Absoft FORTRAN callable C version for NeXT. *----------------------------------------------------------------------- */ void GRGENV(name, value, length, name_dim, value_dim, length_dim) char *name, *value; int *length; int name_dim, value_dim, length_dim; { static char *prefix = "PGPLOT_"; /* Environment variable name prefix */ char test[33]; /* PGPLOT_* Concatenation buffer */ int name_len; /* Un-padded length of 'name' string */ int prefix_len; /* The length of prefix[] */ char *env=0; /* Environment variable value */ int i; /* * Determine the length of 'name' by searching for the last * non-space character. */ name_len = name_dim; while(name_len > 0 && name[name_len-1] == ' ') name_len--; /* * Determine the length of the prefix. */ prefix_len = strlen(prefix); /* * Prefix 'name' with PGPLOT_ if there is room in test[]. */ if(prefix_len + name_len + 1 <= sizeof(test)/sizeof(char)) { strcpy(test, prefix); strncpy(&test[prefix_len], name, name_len); test[prefix_len+name_len] = '\0'; /* * Get the value of the environment variable now named in test[]. */ env = getenv(test); }; /* * Substitute an empty string if no value was obtained, or the value * obtained is too long to fit in the output string. */ if(env==0 || strlen(env) > value_dim) env = ""; /* * Copy the environment variable value into the output string. */ strncpy(value, env, value_dim); /* * Return the unpadded length of the string. */ { int env_len = strlen(env); *length = (env_len <= value_dim) ? env_len : value_dim; }; /* * Pad the fortran string with spaces. */ for(i = *length; i int GROTER(cdev, ldev, w_cdev, w_ldev) char *cdev; long int *ldev; int w_cdev, w_ldev; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } int GRCTER(fd, w_fd) int *fd; int w_fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } GRWTER(fd, cbuf, lbuf, w_fd, w_cbuf, w_lbuf) int *fd; char *cbuf; long int *lbuf; int w_fd, w_cbuf, w_lbuf; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } GRPTER(fd, cprom, lprom, cbuf, lbuf, w_fd, w_cprom, w_lprom, w_cbuf, w_lbuf) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int w_fd, w_cprom, w_lprom, w_cbuf, w_lbuf; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_next/af77_src/gruser.c010064400040640000322000000022050567152653700175130ustar00tjpcitmbr00000400000017/* **GRUSER -- get user name. *+ * SUBROUTINE GRUSER(STRING, L) * CHARACTER*(*) STRING * INTEGER L * * Return the name of the user running the program. * * Arguments: * STRING : receives user name, truncated or extended with * blanks as necessary. * L : receives the number of characters in VALUE, excluding * trailing blanks. *-- * 13-Nov-1994 [mcs] Absoft FORTRAN callable version for NeXT. *----------------------------------------------------------------------- */ char *getlogin(); void GRUSER(string, length, maxlen, w_length) char *string; int *length; int maxlen; int w_length; { int i; /* * Get the login name of the PGPLOT user. */ char *user = getlogin(); /* * If the user name is not available substitute an empty string. */ if(!user) user = ""; /* * Copy the user name to the output string. */ for(i=0; i #include #include #include /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNAME) * INTEGER GROFIL * CHARACTER*(*) FNAME * * Opens file FNAME for writing. * GROFIL returns the file descriptor for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, STRING) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occurred while opening the file. *- */ int GROFIL(fname, fname_len) char *fname; int fname_len; { char *name = fname; /* C pointer to FORTRAN string */ int slen = fname_len; /* Length of the FORTRAN string */ char *buff=0; /* Dynamically allocated copy of name[] */ int fd = -1; /* File descriptor to be returned */ /* * Determine how long the FORTRAN string is by searching for the last * non-blank character in the string. */ while(slen>0 && name[slen-1]==' ') slen--; /* * Dynamically allocate a buffer to copy the FORTRAN string into. */ buff = (char *) malloc((slen+1) * sizeof(char)); if(buff) { /* * Make a C string copy of the FORTRAN string. */ strncpy(buff, name, slen); buff[slen] = '\0'; /* * Open the file and return its descriptor. */ fd = open(buff, O_WRONLY | O_CREAT | O_TRUNC, 0666); free(buff); } else { fprintf(stderr, "gropfil: Insufficient memory\n"); }; return fd; } /* **&GRCFIL -- Close file from GRFILEIO access *+ * FUNCTION GRCFIL (FD) * INTEGER GRCFIL (FD) * * Closes the file with descriptor FD from GRFILEIO access. GRCFIL returns * 0 when properly closed. Otherwise, use PERRORF to report the error. * * Usage: * IOS = GRCFIL (FD) * or: * CALL GRCFIL (FD) * * In the last case the return code is ignored. * * Arguments: * FD (input) : File descriptor returned by GROFIL. * GRCFIL (output) : Error code or 0 on proper closing. *- */ int GRCFIL(fd, w_fd) int *fd; int w_fd; /* Width of fd argument (appended by Absoft FORTRAN) */ { return close(*fd); } /* **&GRWFIL -- GRFILEIO write routine *+ * FUNCTION GRWFIL (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFIL * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFIL. If * GRWFIL < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFIL (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFIL(fd, nbytes, buf, w_fd, w_nbytes, w_buf) int *fd, *nbytes; char *buf; int w_fd, w_nbytes, w_buf; /* Width of arguments */ { return write(*fd, (void *) buf, *nbytes); } /* **&GRWFCH -- GRFILEIO write FORTRAN character sub-STRING routine *+ * FUNCTION GRWFCH (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFCH * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFCH. If * GRWFCH < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFCH (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFCH(fd, nbytes, buf, w_fd, w_nbytes, w_buf) int *fd, *nbytes; char *buf; int w_fd, w_nbytes, w_buf; /* Width of arguments */ { return write(*fd, (void *) buf, *nbytes); } for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, STRING) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occpgplot/sys_next/af77_src/grgetc.c010064400040640000322000000054010567152654000174520ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) GRGETC(val, w_val) int *val; int w_val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_next/af77_src/rvwrap.c010064400040640000322000000007120631546407400175170ustar00tjpcitmbr00000400000017void xwdriv_(); /* * This is a wrapper function used to call the /xrv driver from * Absoft FORTRAN (NeXT). *-- * 24-Mar-1997 - [mcs] */ void RVDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode) int *ifunc; float *rbuf; int *nbuf; char *chr; int *lchr; int w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode; /* Argument widths */ { rvdriv_(ifunc, rbuf, nbuf, chr, lchr, mode, w_chr); return; } pgplot/sys_next/af77_src/tkwrap.c010064400040640000322000000007120631546403300175010ustar00tjpcitmbr00000400000017void xwdriv_(); /* * This is a wrapper function used to call the /xtk driver from * Absoft FORTRAN (NeXT). *-- * 24-Mar-1997 - [mcs] */ void TKDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode) int *ifunc; float *rbuf; int *nbuf; char *chr; int *lchr; int w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode; /* Argument widths */ { tkdriv_(ifunc, rbuf, nbuf, chr, lchr, mode, w_chr); return; } pgplot/sys_next/af77_src/xmwrap.c010064400040640000322000000007150631546402000175060ustar00tjpcitmbr00000400000017void xwdriv_(); /* * This is a wrapper function used to call the /xmotif driver from * Absoft FORTRAN (NeXT). *-- * 24-Mar-1997 - [mcs] */ void XMDRIV(ifunc, rbuf, nbuf, chr, lchr, mode, w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode) int *ifunc; float *rbuf; int *nbuf; char *chr; int *lchr; int w_ifunc, w_rbuf, w_nbuf, w_chr, w_lchr, w_mode; /* Argument widths */ { xmdriv_(ifunc, rbuf, nbuf, chr, lchr, mode, w_chr); return; } pgplot/sys_next/gf77_src/grtermio.c010064400040640000322000000057100567152654000200400ustar00tjpcitmbr00000400000017/* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRRTER. */ #include long int groter_(cdev, ldev, cdev_len) char *cdev; long int *ldev; int cdev_len; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * cdev_len I Used by Fortran compiler to pass character length * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } grcter_(fd) int *fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } grwter_(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; long int *lbuf; int cbuf_len; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return * cbuf_len I Used by Fortran compiler to pass character length */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } grpter_(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int cprom_len, cbuf_len; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read * cbuf_len I Used by Fortran compiler to pass character length */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_next/gf77_src/grgcom.f010064400040640000322000000017550567152654000174760ustar00tjpcitmbr00000400000017C*GRGCOM -- read with prompt from user's terminal (NeXT version) C+ INTEGER FUNCTION GRGCOM(STRING, PROMPT, L) CHARACTER*(*) STRING, PROMPT INTEGER L C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C STRING : (output) receives the string read from the terminal. C PROMPT : (input) prompt string. C L : (output) length of STRING. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 1991-Jul-02 - From SUN version [AFT] C----------------------------------------------------------------------- INTEGER IER C GRGCOM = 0 L = 0 IER = 0 C WRITE (*, '(A,$)', IOSTAT=IER) PROMPT WRITE (*, 121, IOSTAT=IER) PROMPT 121 FORMAT('$',A) IF (IER.EQ.0) READ (*, '(A)', IOSTAT=IER) STRING IF (IER.EQ.0) GRGCOM = 1 L = LEN(STRING) 10 IF (STRING(L:L).NE.' ') GOTO 20 L = L-1 GOTO 10 20 CONTINUE END pgplot/sys_next/gf77_src/grsy00.f010064400040640000322000000076140567152654100173450ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDFON and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDFON(N)), where INDFON is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDFON(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C----------------------------------------------------------------------- CHARACTER*(*) UNIX PARAMETER (UNIX='/usr/local/vlb/pgplot/grfont.dat') INTEGER MAXCHR PARAMETER (MAXCHR=3000) C CHARACTER*128 FF INTEGER FNTFIL, I, IER, IREC, IS, K, NC3 INTEGER L C INTEGER*2 BUFFER(27000) INTEGER INDFON(3000), NC1, NC2 COMMON /GRSYMB/ NC1, NC2, INDFON, BUFFER C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGENV('FONT', FF, L) IF (L.EQ.0) THEN FF = UNIX L = LEN(UNIX) END IF CALL GRGLUN(FNTFIL) IF(INDEX(FF(:L),'dat').GT.0) THEN OPEN (UNIT=FNTFIL, FILE=FF(:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDFON,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) ELSE OPEN (UNIT=2, STATUS='OLD', FILE=FF(:L), : ACCESS='DIRECT', RECL=MAXCHR/4) IREC=0 IS=1 READ(2, REC=IREC+1) (INDFON(K),K=IS,IS+MAXCHR/4-1) IREC=IREC+1 IF(INDFON(1).NE.123) THEN CALL GRWARN('Bad magic number in font file.') IER=1 GOTO 190 END IF NC1=INDFON(2) NC2=INDFON(3) IS=1 DO 140 I=1,4 READ(2, REC=IREC+1) (INDFON(K),K=IS,IS+MAXCHR/4-1) IREC=IREC+1 IS=IS+MAXCHR/4 140 CONTINUE IS=1 DO 160 I=1,18 READ(2, REC=IREC+1) (BUFFER(K),K=IS,IS+MAXCHR/2-1) IREC=IREC+1 IS=IS+MAXCHR/2 160 CONTINUE END IF C 190 CONTINUE CALL GRFLUN(FNTFIL) IF (IER.NE.0) CALL GRWARN('Unable to read font file: '//FF(:L)) RETURN END pgplot/sys_next/gf77_src/grgetc.c010064400040640000322000000053600567152654100174650ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) grgetc_(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_next/gf77_src/pgpack.f010064400040640000322000000076730567152653300174740ustar00tjpcitmbr00000400000017 PROGRAM PACK C----------------------------------------------------------------------- C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000) C INTEGER INDEX(MAXCHR), IHEAD(MAXCHR/4) INTEGER*2 BUFFER(MAXBUF) INTEGER I, IREC, IS, K, LENGTH, LOC INTEGER NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open stdin. C C Read input file. C 10 CONTINUE C -- read next character READ (*,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (*,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC BUFFER(LOC) = XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE C C Write output file. C OPEN (UNIT=2, STATUS='NEW', FILE='grfont.daf', : ACCESS='DIRECT', RECL=MAXCHR/4) C NC1 = 1 C NC2 = 3000 C WRITE (2) NC1,NC2,LOC,INDEX,BUFFER C WRITE (2) NC1,NC2,LOC,INDEX C WRITE (2) (BUFFER(K),K=1,13500) C WRITE (2) (BUFFER(K),K=13501,27000) C Magic number (to get byte swap) IHEAD(1)=123 IHEAD(2)=1 IHEAD(3)=3000 IHEAD(4)=LOC IREC=1 WRITE(2, REC=IREC) IHEAD IS=1 DO 140 I=1,4 WRITE(2, REC=IREC+1) (INDEX(K),K=IS,IS+MAXCHR/4-1) IREC=IREC+1 IS=IS+MAXCHR/4 140 CONTINUE IS=1 DO 160 I=1,18 WRITE(2, REC=IREC+1) (BUFFER(K),K=IS,IS+MAXCHR/2-1) IREC=IREC+1 IS=IS+MAXCHR/2 160 CONTINUE CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/sys_next/pgview/Dispatch.h010064400040640000322000000006150567152654100176340ustar00tjpcitmbr00000400000017/* Generated by Interface Builder */ #import #import "PGView.h" #import "pgvListener.h" #import @interface Dispatch:Object { id infoPanel; Listener *myListener; NXCursor *crossCursor; PGView *curView; BOOL qdrawing; int iwtype; } - showInfo:sender; - newLand:sender; - newPort:sender; - print:sender; @end pgplot/sys_next/pgview/Dispatch.m010064400040640000322000000115560567152654100176470ustar00tjpcitmbr00000400000017// Dispatch is the central clearinghouse for the pgview program. Dispatch // creates a Listener object to listen to messages from PGPLOT programs. // Most of these messages are routed to the active PGView object. // Dispatch also allows the user to create new windows and to print // windows using the main menu. Since changing windows in the middle of // a PostScript stream may cause problems, Dispatch does now allow the // active window to change if PGPLOT is in the midst of a plot, i.e., // between the Begin Picture and End Picture commands. Since most PGPLOT // programs only send an End Picture immdediately prior to the next Begin // Picture command, this means that you will not be able to change windows // while most PGPLOT programs are running. // // 1992-Mar-9 - [AFT] //--- #import "Dispatch.h" #import #import #import "PGView.h" #import "pgvListener.h" #import "sername.h" @implementation Dispatch // //--- Class methods ----------------------------------------------------- // - init { NXPoint spot; [super init]; // Listen for PGPLOT programs myListener = [[pgvListener alloc] init]; [myListener checkInAs: PGV_SERVER_NAME]; [myListener addPort]; [myListener setDelegate:self]; // Scale print jobs to print on one page. Note setxxxPagination does not // return self. [[NXApp printInfo] setHorizPagination:NX_FITPAGINATION]; [[NXApp printInfo] setVertPagination:NX_FITPAGINATION]; // Prepare the cross cursor crossCursor=[[NXCursor alloc] initFromImage:[NXImage newFromSection:"cross.tiff"]]; spot.x = spot.y = 7.0; [crossCursor setHotSpot:&spot]; // 0=Landscape, 1=portrait iwtype=0; curView=NULL; qdrawing=NO; return self; } // //--- Window delegate --------------------------------------------------- // - windowDidBecomeMain:sender // If PGPLOT is actively drawing, then we try to prevent the key window // from changing. This is done so that the main window (i.e., the one // with the back title bar) will denote the currently active plot window. { if( qdrawing ) { if( [sender contentView] != curView) { [[curView window] makeKeyWindow]; } } else { curView=[sender contentView]; [curView gettype: &iwtype]; if(iwtype==0) { [[NXApp printInfo] setOrientation:NX_LANDSCAPE andAdjust:YES]; } else { [[NXApp printInfo] setOrientation:NX_PORTRAIT andAdjust:YES]; } } return self; } - windowWillClose:sender // Prevent PGPLOT from trying to draw to a window that was closed. { if( curView == [sender contentView] ) curView=NULL; return self; } // //--- Targets for menu items -------------------------------------------- // - showInfo:sender { if(!infoPanel) { [NXApp loadNibSection:"info.nib" owner:self]; } [infoPanel makeKeyAndOrderFront:self]; return self; } - newLand:sender { static NXRect wRect = {{330.0, 230.0},{720.0,535.0}}; PGView *newView; newView = [[PGView alloc] initFrame:&wRect]; [[newView window] setDelegate:self]; if( !qdrawing ) { curView=newView; iwtype=0; [[NXApp printInfo] setOrientation:NX_LANDSCAPE andAdjust:YES]; } return self; } - newPort:sender { static NXRect wRect = {{500.0, 70.0},{535.0,720.0}}; PGView *newView; newView = [[PGView alloc] initFrame:&wRect]; [[newView window] setDelegate:self]; if( !qdrawing ) { curView=newView; iwtype=1; [[NXApp printInfo] setOrientation:NX_PORTRAIT andAdjust:YES]; } return self; } - print:sender { [curView printPSCode:self]; return self; } // //--- Listener methods -------------------------------------------------- // - beginp { qdrawing=YES; [curView beginp]; if([NXApp isHidden]) { [NXApp unhideWithoutActivation:self]; } if(![[curView window] isVisible]) { [[curView window] orderFront:self]; } return 0; } - cursorat: (double *) xpos and: (double *) ypos char: (int *) ichar { NXPoint aPoint; aPoint.x=(float) *xpos; aPoint.y=(float) *ypos; [curView readcursor: &aPoint char: ichar cursor:crossCursor]; *xpos=(double) aPoint.x; *ypos=(double) aPoint.y; return 0; } - flush { [curView flush]; return 0; } - getwind: (int *) ixdim by: (int *) iydim scale: (double *) dmag color: (int *) icol { if(curView == NULL) { if(iwtype==0) { [self newLand:self]; } else { [self newPort:self]; } } [curView getwind:ixdim by:iydim color:icol scale:dmag]; return 0; } - pscode: (char *) cbuf { [curView pscode:cbuf]; return 0; } - endp { qdrawing=NO; return 0; } @end pgplot/sys_next/pgview/Makefile010064400040640000322000000015700602363060100173460ustar00tjpcitmbr00000400000017# # Generated by the NeXT Project Builder. # # NOTE: Do NOT change this file -- Project Builder maintains it. # # Put all of your customizations in files called Makefile.preamble # and Makefile.postamble (both optional), and Makefile will include them. # NAME = pgview PROJECTVERSION = 1.1 LANGUAGE = English APPICON = pgicon.tiff GLOBAL_RESOURCES = info.nib pgview.nib cross.tiff pgicon.tiff CLASSES = Dispatch.m PGView.m pgvListener.m HFILES = Dispatch.h PGView.h pgvListener.h MFILES = pgview_main.m OTHERSRCS = pgv.msg MAKEFILEDIR = /NextDeveloper/Makefiles/app INSTALLDIR = $(HOME)/Apps INSTALLFLAGS = -c -s -m 755 SOURCEMODE = 444 ICONSECTIONS = -sectcreate __ICON app pgicon.tiff LIBS = -lMedia_s -lNeXT_s DEBUG_LIBS = $(LIBS) PROF_LIBS = $(LIBS) -include Makefile.preamble include $(MAKEFILEDIR)/app.make -include Makefile.postamble -include Makefile.dependencies pgplot/sys_next/pgview/Makefile.postamble010064400040640000322000000003350567170055600213500ustar00tjpcitmbr00000400000017demo: demo.o nexsup.o mkspeak.o pgvSpeaker.o cc -o demo demo.o nexsup.o mkspeak.o pgvSpeaker.o -lNeXT_s pgvSpeaker.h pgvListener.h pgvSpeaker.m pgvListener.m: pgv.msg msgwrap pgv.msg clean:: rm -f pgvListener.m demo pgplot/sys_next/pgview/PB.project010064400040640000322000000012700602363060000175730ustar00tjpcitmbr00000400000017INSTALLDIR = "$(HOME)/Apps"; APPICON = pgicon.tiff; GENERATEMAIN = YES; DOCICONFILES = (); FILESTABLE = { M_FILES = (pgview_main.m); OTHER_LINKED = (); H_FILES = (Dispatch.h, PGView.h, pgvListener.h); CLASSES = (Dispatch.m, PGView.m, pgvListener.m); IMAGES = (cross.tiff, pgicon.tiff); PSW_FILES = (); C_FILES = (); OTHER_SOURCES = (pgv.msg); SUBPROJECTS = (); PSWM_FILES = (); SOUNDS = (); OTHER_LIBS = (Media_s, NeXT_s); INTERFACES = (info.nib, pgview.nib); }; APPCLASS = Application; MAINNIB = pgview; DOCEXTENSIONS = (); PROJECTTYPE = Application; LOCALIZABLE_FILES = { }; PROJECTVERSION = 1.1; PROJECTNAME = pgview; SYSTEMEXTENSIONS = (); pgplot/sys_next/pgview/PGView.h010064400040640000322000000012300567152654200172310ustar00tjpcitmbr00000400000017/* Generated by Interface Builder */ #import #import #import @interface PGView:View { Storage *psdata; NXCoord prevw, prevh; int lwtype; DPSContext ctxt; int iflush, nbuf, nplot; } - initFrame:(const NXRect *) frameRect; - drawSelf:(const NXRect *) rects :(int)rectCount; - pgplotDefs; - beginp; - flush; - gettype: (int *) iptype; - getwind: (int *) ixdim by: (int *) iydim color: (int *) icol scale: (double *) dmag; - pscode: (char *) cbuf; - readcursor: (NXPoint *) aPoint char: (int *) ichar cursor: (NXCursor *) crossCursor; @end pgplot/sys_next/pgview/PGView.m010064400040640000322000000167270570555274200172560ustar00tjpcitmbr00000400000017// PGView is the custom view object for the pgview program. PGView // receives 132 byte character arrays filled with PostScript code. PGView // saves these buffers in a Storage object. When the PGPLOT program // executes a flush operation, this stored data is then sent to the // display. // // 1992-Mar-9 - [AFT] //--- #import "PGView.h" #import #import #import #import #import // for PSxxxx routines @implementation PGView - initFrame:(const NXRect *) frameRect { id myWindow; [super initFrame:frameRect]; // Create an enclosing window and bring it upfront myWindow = [[Window alloc] initContent:frameRect style:NX_RESIZEBARSTYLE backing:NX_BUFFERED buttonMask:(NX_MINIATURIZEBUTTONMASK | NX_CLOSEBUTTONMASK) defer:NO]; [myWindow setContentView:self]; [myWindow setBackgroundGray:NX_WHITE]; [myWindow setFreeWhenClosed:YES]; [[[window setTitle:"PGPLOT Viewer"] display] orderFront:self]; // Save portrait/landscape flag if( frameRect->size.width > frameRect->size.height) { lwtype=0; } else { lwtype=1; } // Needed to do PostScript scaling [self scale:0.1 :0.1]; prevw = bounds.size.width; prevh = bounds.size.height; // Buffer is used to store PostScript data psdata = [Storage newCount:1 elementSize:132 description:"[132c]"]; iflush=0; nbuf=0; nplot=0; // Allocate private graphics state, so things like the current color // setting will be preserved between different calls to drawSelf. [self notifyToInitGState:YES]; [self allocateGState]; return self; } - drawSelf:(const NXRect *) rects :(int)rectCount { char *ctmp; int i, ibeg; ctxt= DPSGetCurrentContext(); if ([psdata count] > 0) { if( prevw != bounds.size.width || prevh != bounds.size.height) { [self scale:bounds.size.width/prevw :bounds.size.height/prevh]; prevw = bounds.size.width; prevh = bounds.size.height; } // If PGPLOT sent a 'flush' message, then only send new data to sceen. if( iflush>0 ) { ibeg=nplot; } else { ibeg=0; } nplot = nbuf; for(i=ibeg; i0 ) { PScurrentgstate([self gState]); PSpop(); } } return self; } - free { [psdata free]; return [super free]; } - endPrologue // This routine sends the PGPLOT defines to the print job. { ctxt= DPSGetCurrentContext(); [self pgplotDefs]; return [super endPrologue]; } - pgplotDefs { DPSPrintf(ctxt, "/l {moveto rlineto currentpoint stroke moveto} bind def\n"); DPSPrintf(ctxt, "/c {rlineto currentpoint stroke moveto} bind def\n"); DPSPrintf(ctxt, "/d {moveto 0 0 rlineto currentpoint stroke moveto} bind def\n"); DPSPrintf(ctxt,"/SLW {5 mul setlinewidth} bind def\n"); DPSPrintf(ctxt,"/BP {newpath moveto} bind def\n"); DPSPrintf(ctxt,"/LP /rlineto load def\n"); DPSPrintf(ctxt,"/EP {rlineto closepath eofill} bind def\n"); return self; } - beginp { [self lockFocus]; ctxt= DPSGetCurrentContext(); DPSPrintf(ctxt,"cleardictstack\n"); [self pgplotDefs]; [self unlockFocus]; [psdata empty]; nbuf=0; nplot=0; return self; } - flush { if ([psdata count] > nplot) { iflush=1; nbuf=[psdata count]; [self display]; iflush=0; } return self; } - gettype: (int *) iwtype; { *iwtype=lwtype; return self; } - getwind: (int *) ixdim by: (int *) iydim color: (int *) icol scale: (double *) dmag { *ixdim= (int) (bounds.size.width+0.5); *iydim= (int) (bounds.size.height+0.5); *icol = [self shouldDrawColor]; *dmag=10.0; return self; } - pscode: (char *) cbuf { [psdata addElement:(void *) cbuf]; return self; } - readcursor: (NXPoint *) aPoint char: (int *) ichar cursor: (NXCursor *) crossCursor { int lasact, iwindnum; NXEvent *nextEvent; NXModalSession session; NXPoint curPoint; NXRect hitRect; BOOL qinside, qloop; // Since pgview is not the active application, it cannot read the // the keyboard. The following code forces pgview to become the // active application. lasact= [NXApp activateSelf:YES]; // Calculate the coordinates of the view in the window coordinate system. [self getFrame:&hitRect]; [superview convertRect:&hitRect toView:nil]; [window makeKeyAndOrderFront:self]; [window getMouseLocation:&curPoint]; qinside=[self mouse:&curPoint inRect:&hitRect]; [window setTrackingRect:&hitRect inside:qinside owner:self tag:1 left:NO right:NO]; iwindnum=[window windowNum]; [self lockFocus]; // If I don't use a Modal loop, then sometimes a busy cursor occurs. // The modal loop is the only way I know how to prevent this, sorry. [NXApp beginModalSession: &session for:window]; [NXApp runModalSession: &session]; PSshowcursor(); if(qinside) { [crossCursor set]; } // Following should work, but doesn't // [self addCursorRect:&hitRect cursor:crossCursor]; qloop=YES; do { nextEvent=[NXApp getNextEvent: NX_MOUSEDOWNMASK | NX_MOUSEUPMASK | NX_KEYDOWNMASK | NX_KEYUPMASK | NX_MOUSEENTEREDMASK | NX_MOUSEEXITEDMASK ]; switch (nextEvent->type) { case NX_MOUSEDOWN: case NX_KEYDOWN: // Ignore down events. break; case NX_MOUSEUP: case NX_KEYUP: // Only process events if mouse is inside the current view. if(qinside) { if(nextEvent->type==NX_KEYUP) { *ichar= (int) nextEvent->data.key.charCode; [window getMouseLocation:&curPoint]; } else { *ichar= 65; curPoint=nextEvent->location; } // First convert from pixel coordinate in the window system to view [superview convertPointFromSuperview:&curPoint]; // Now convert from pixel to scaled coordinate [self convertPointFromSuperview:&curPoint]; *aPoint = curPoint; qloop=NO; } break; case NX_MOUSEENTERED: qinside = YES; [crossCursor set]; break; case NX_MOUSEEXITED: qinside = NO; [NXArrow set]; break; default: printf("PGView--mystery event type=%d flags=%d window=%u\n", nextEvent->type, nextEvent->flags, nextEvent->window); break; } } while (qloop); [NXArrow set]; [NXApp endModalSession: &session]; [self unlockFocus]; // Sending an active:lstact message to NXApp does not always work. The // problem occurs if pgview was launched via an 'open -a' statement and // for the second (and following) cursor reads in pgex15. The following // is less 'user friendly' but safer. [NXApp deactivateSelf]; return self; } @end pgplot/sys_next/pgview/cross.tiff010064400040640000322000000004140567152654200177250ustar00tjpcitmbr00000400000017MM* ÿü@@@@@@UTUT@UTUT@@@@@@@@@@@@UWUTÿÿôUWUT@@@@@@|¼@@pgplot/sys_next/pgview/demo.m010064400040640000322000000030460567152654300170310ustar00tjpcitmbr00000400000017#include #include void main(int argc, char *argv[]) { void nexsup_( int *ifunc, char *cbuf, float *rtmp); char *cbuf=NULL; float rtmp[20]; int ifunc; ifunc=1; printf("demo--Sending ifunc=1 showwind/getsize.\n"); nexsup_(&ifunc, cbuf, rtmp); printf("demo-window size is %f %f %f\n",rtmp[0],rtmp[1],rtmp[2]); ifunc=2; rtmp[0]=1.; printf("demo--Sending ifunc=2 beginp/clear\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc, ".20 setgray newpath 50 50 moveto 100 500 lineto stroke", rtmp); ifunc=5; printf("demo--Sending ifunc=5, flush\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc, "newpath 100 100 moveto 100 0 rlineto 0 100 rlineto -100 0 rlineto closepath eofill", rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc,"newpath 0 0 moveto 20 20 lineto stroke", rtmp); /* ifunc=3; printf("demo--Sending ifunc=3, userpath.\n"); nexsup_(&ifunc, "[ [ 0 0 200 200 175 100 200 100 100 175 100 200 25 100 0 100 100 25 100 0 ] <000103010301030103> ] ustroke", rtmp); */ ifunc=5; printf("demo--Sending ifunc=5, flush\n"); nexsup_(&ifunc, cbuf, rtmp); /* ifunc=4; printf("demo--Sending ifunc=4 read cursor.\n"); nexsup_(&ifunc, cbuf, rtmp); printf("demo--Cursor= %f %f %f\n",rtmp[0],rtmp[1],rtmp[2]); */ exit(0); } pgplot/sys_next/pgview/info.nib010064400040640000322000000037040567152654300173550ustar00tjpcitmbr00000400000017 typedstream¢„@„„„ StreamTable„„ HashTable„„Object…„i%%„i„!—˜—˜—˜——„[20c] typedstream¢„@…——ˆ„[648c] typedstream¢„@„„„ HashTable„„Object…„i%%„%’–„FirstResponder’„„„ HeaderClass”„%%%%i@@—”…„firstnib„“•–„i†„“•–›–„checkSpelling:›–„alignSelCenter:›–„ unscript:›–„ pasteFont:›–„cut:›–„runPageLayout:›–„ superscript:›–„ copyRuler:›–„ copyFont:›–„ selectAll:›–„ pasteRuler:›–„ toggleRuler:›–„showGuessPanel:›–„ alignSelLeft:›–„paste:›–„ performClose:›–„arrangeInFront:›–„ subscript:›–„copy:›–„alignSelRight:›–„delete:›–„orderFrontColorPanel:›–„ underline:›–„performMiniaturize:›††–„Dispatch’„–™´”„„genericobject_nib„“•–›–„ infoPanel›–„nibView› †„“•–›–„newLand:› –„newPort:› –„ showInfo:›†††——¯„[1199c] typedstream¢„@„„„ HashTable„„Object…„i%%„i’–’„„„List”–†–’„––†–’„„„NibData”„@@@@s„„„Storage”„%ii„{*@@} „[8{*@@}]„„ File's Owner„„„ CustomObject”„*@„„Dispatch…†…„„Info„„„WindowTemplate”„ffff÷b‚„ iiii***@s@‚ï„¢„„View„„Panel„„¦„„ Responder”’…„f¤b‚¤b‚’…’…„@ss@„––„[6@]„„„ TextField„„Control§’¦©¤ƒU’¤’’¦’…ª…@…„i@s„„„ TextFieldCell„„ ActionCell„„Cell”„*@ss„„ PGPLOT Viewer„„„Font”„*fss„„ Helvetica†’…„i:…„ffÿ„c¹†À’…’…’…„:…†„«’¦©¤B ¤B ’¦’…ª…@…®„®²„„ 1992-Mar-5„³µ„¶ †’…·…¸ÿƒ>ªª«¹¹†À’…’…’…º…†„«’¦©¤;t¤t’¦’…ª…@…®„®²„„by Allyn Tennant„³µ„¶†’…·…¸ÿ¹¹†À’…’…’…º…†„„„Button¬’¦©¤<00¤00’¦’…ª…ˆ@…®„„„ ButtonCell¯²…„³µ„¶ €†+’…·…„ssȲ……‡@„@@„„„NXImage”„s*"„„pgicon†…†Ð†„«’¦©¤E ¤ ’¦’…ª…@…®„®²„„4X-ray Astronomy Branch, Marshall Space Flight Center¸’…·…¸ƒ?*ª«ƒ>ªª«¹¹†À’…’…’…º…†„„„Box§’¦©¤’¤’’¦’…ª„––„[1@]„§’Ë©¤Ž¤Ž’Ë’…ª……††…¸„@@s„°²„ÅÆÎÀ††…†p…†„„Button1¿¡„„Field1ª¡„„Field2º¡„„ VersionNumberµ¡„„FieldÈ¡„ÅË¡†„››„{i*@@@}„ [1{i*@@@}]„„ infoPanel¡…†„––†…†††pgplot/sys_next/pgview/mkspeak.m010064400040640000322000000024430614143276400175320ustar00tjpcitmbr00000400000017#import "pgvSpeaker.h" #import // POSIX defines sleep in which does not exist on the NeXT, sigh. unsigned int sleep(unsigned int seconds); void mkspeak( id *retSpeaker) // // This routine creates a Speaker object for communicating with the // PGPLOT viewer. If there is no Listener then the pgview program is // launched, and waits up to 11 secs to connect to the port. Of course, // this means the pgview must lie in your current path. // { #include "sername.h" //#include port_t thePort; id mySpeaker; int icnt; mySpeaker = [[pgvSpeaker alloc] init]; thePort = NXPortFromName(PGV_SERVER_NAME, NULL); if (thePort==PORT_NULL) { printf("Launching pgview...\n"); // system("open -a pgview &"); system("open /LocalApps/pgview.app/pgview"); icnt=1; while (thePort==PORT_NULL && icnt<21) { sleep(1); if((icnt/5)*5 == icnt) printf("waiting...\n"); thePort = NXPortFromName(PGV_SERVER_NAME, NULL); icnt=icnt+1; } /* end while */ if (thePort==PORT_NULL) { printf("Could not find port connected to pgview.\n"); exit(1); } /* end if */ } /* end if */ [mySpeaker setSendPort:thePort]; *retSpeaker=mySpeaker; } pgplot/sys_next/pgview/pgicon.tiff010064400040640000322000000024260567152654200200600ustar00tjpcitmbr00000400000017MM*ˆÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÀÿÿÏüÿÏüÿÏüÿÏÿÿÏÿÿÿÿÿÿÿÿÏÿÿÏÿÿÿÿÿÿÿÿÏÿÿÏÿÿÿÿÿÿÿÿÏÿÿÏÿÿÿÿÿÿÿÿÏÿÿÃÿÿ_ÿðÿÿÏÿý÷ÿóÿÿóÏÿÿÏÿý÷ÿóÿÿóÏÿÿÏÿ÷÷ÿóÿóÏÿÿÏÿ×÷ÿóýßóÏÿÿÏýõÿóýßóÏÿÿÃ×ÿýÿóýßóÿÿÏÿýÿó÷÷óÏÿÿÍÿÿýÿó×õóÏÿÿÇÿÿýÿóßýóÏÿÿÇÿÿÿñÿSÏÿÿÏÿÿÿóÿÿóÏÿÿÃÿÿÿðÿÿÏÿÿÿ_ÿÿÿÿÏÿÿÏÿÿÿßÿÿÿÿÏÿÿÏÿÿÿ÷ÿÿÿÿÏÿÿÏÿÿÿ÷ÿÿÿÿÏÿÿÏÿÿÿõÿÿÿÿÏÿÿÃÿÿÿýUÿÿÿÿÿÏÿÿÿÿÿ_ÿÿÏÿÿÏÿÿÿÿÿõÿÿÏÿÿÏÿÿÿÿÿÿÿÏÿÿÏÿÿÿÿÿÿÕÿÏÿÿÏüÿÏüÿÏüÏÿÿÀÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ 00€ãH@@pgplot/sys_next/pgview/pgv.msg010064400040640000322000000003340567152654300172300ustar00tjpcitmbr00000400000017- beginp; - cursorat: (double *) xpos and: (double *) ypos char: (int *) ichar; - flush; - getwind: (int *) ixdim by: (int *) iydim scale: (double *) dmag color: (int *) icol; - pscode: (char *) cbuf; - endp; pgplot/sys_next/pgview/pgvListener.h010064400040640000322000000004740614144042200203640ustar00tjpcitmbr00000400000017#import @interface pgvListener : Listener {} -(int)beginp; -(int)cursorat : (double *) xpos and : (double *) ypos char : (int *) ichar; -(int)flush; -(int)getwind : (int *) ixdim by : (int *) iydim scale : (double *) dmag color : (int *) icol; -(int)pscode : (char *) cbuf; -(int)endp; @end pgplot/sys_next/pgview/pgvSpeaker.h010064400040640000322000000004710614144042200201660ustar00tjpcitmbr00000400000017#import @interface pgvSpeaker : Speaker {} -(int)beginp; -(int)cursorat : (double *) xpos and : (double *) ypos char : (int *) ichar; -(int)flush; -(int)getwind : (int *) ixdim by : (int *) iydim scale : (double *) dmag color : (int *) icol; -(int)pscode : (char *) cbuf; -(int)endp; @end pgplot/sys_next/pgview/pgvSpeaker.m010064400040640000322000000016600614144042200201740ustar00tjpcitmbr00000400000017#import #import "pgvSpeaker.h" #import #import #import extern port_t name_server_port; extern id NXResponsibleDelegate(); @implementation pgvSpeaker :Speaker {} -(int)beginp /* */ { return [self selectorRPC:"beginp" paramTypes:""]; } -(int)cursorat : (double *) xpos and : (double *) ypos char : (int *) ichar /* */ { return [self selectorRPC:"cursorat:and:char:" paramTypes:"DDI", xpos, ypos, ichar]; } -(int)flush /* */ { return [self selectorRPC:"flush" paramTypes:""]; } -(int)getwind : (int *) ixdim by : (int *) iydim scale : (double *) dmag color : (int *) icol /* */ { return [self selectorRPC:"getwind:by:scale:color:" paramTypes:"IIDI", ixdim, iydim, dmag, icol]; } -(int)pscode : (char *) cbuf /* */ { return [self selectorRPC:"pscode:" paramTypes:"c", cbuf]; } -(int)endp /* */ { return [self selectorRPC:"endp" paramTypes:""]; } @end pgplot/sys_next/pgview/pgview.iconheader010064400040640000322000000000540602363057600212410ustar00tjpcitmbr00000400000017F pgview.app pgview app F pgview pgview app pgplot/sys_next/pgview/pgview.nib010064400040640000322000000033460567152654200177240ustar00tjpcitmbr00000400000017 typedstream¢„@„„„ StreamTable„„ HashTable„„Object…„i%%„i„!—˜—˜—˜——„[20c] typedstream¢„@…——“„[659c] typedstream¢„@„„„ HashTable„„Object…„i%%„%’–„FirstResponder’„„„ HeaderClass”„%%%%i@@—”…„firstnib„“•–„i†„“•–›–„checkSpelling:›–„alignSelCenter:›–„ unscript:›–„ pasteFont:›–„cut:›–„runPageLayout:›–„ superscript:›–„ copyRuler:›–„ copyFont:›–„ selectAll:›–„ pasteRuler:›–„ toggleRuler:›–„showGuessPanel:›–„ alignSelLeft:›–„paste:›–„ performClose:›–„arrangeInFront:›–„ subscript:›–„copy:›–„alignSelRight:›–„delete:›–„orderFrontColorPanel:›–„ underline:›–„performMiniaturize:›††–„Dispatch’„–™´”„„genericobject_nib„“•–›–„ infoPanel›–„nibView› †„“•–›–„newLand:› –„ showInfo:›–„print:›–„newPort:› †††——Ç„[967c] typedstream¢„@„„„ HashTable„„Object…„i%%„i’–’„„„List”–†–’„––†–’„„„NibData”„@@@@s„„„Storage”„%ii„{*@@} „[9{*@@}]„„ File's Owner„„„ CustomObject”„*@„„ Application…†…„„MainMenu„„„ MenuTemplate”’…„ff ¤„*@*@ccc„„pgview„„„Matrix„„Control„„View„„ Responder”’…„f„ffffZx¬Zx’…’…„@ss@…@…„i@s…Ø’…’…’…’…„@:@iiii„––„[6@]„„„MenuCell„„ ButtonCell„„ ActionCell„„Cell”„*@ss„„Info...„„„Font”„*fss„„ Helvetica €†’…„i:…„ssȵ……©„@f°’…„:…†„«µ„„ Landscape°’…º…»Èµ……©¼°’…½…†„«µ„„Portrait°’…º…»Èµ……©¼°’…½…†„«µ„„Print...°’…º…»Èµ……©p¼°’…½…†„«µ„„Hide°’…º…»Èµ……©h¼°’…½…†„«µ„„Quit°’…º…»Èµ……©q¼°’…½…††……ÿÿ¤Z¤„ff@@#::sÿÿ……«……„cĆ„„Menu…†„Á¹¡„„Infoª¡„»¡„¾³¡„¿µ¡„À·¡„„DispatchInstance„ž „„Dispatch…††„››„{i*@@@}„ [6{i*@@@}]„„hide:¹…„„ terminate:»…„„ showInfo:ªÅ…„„newLand:³Å…„„newPort:µÅ…„„print:·Å…†„––†…†††pgplot/sys_next/pgview/pgview_main.m010064400040640000322000000005130602363057000203720ustar00tjpcitmbr00000400000017/* Generated by the NeXT Project Builder NOTE: Do NOT change this file -- Project Builder maintains it. */ #import void main(int argc, char *argv[]) { [Application new]; if ([NXApp loadNibSection:"pgview.nib" owner:NXApp withNames:NO]) [NXApp run]; [NXApp free]; exit(0); } pgplot/sys_next/pgview/sername.h010064400040640000322000000001370567152654300175300ustar00tjpcitmbr00000400000017/* sername.h: Define name for PGPLOT View server */ #define PGV_SERVER_NAME "PGPlot-Server2" pgplot/sys_next/f2c_src/iand.c010064400040640000322000000002200567152654300170150ustar00tjpcitmbr00000400000017int iand_ (a,b) int *a; int *b; { static int res; res = (*a & *b); /* printf ("iand result: %d\n",res); */ return (res); } pgplot/sys_next/f2c_src/nfc010075500040640000322000000062050567136706700164470ustar00tjpcitmbr00000400000017#!/bin/sh PATH=/bin:/usr/bin:/usr/local/bin # f77-style shell script to compile and load fortran, C, and assembly codes # usage: f77 [-g] [-O] [-o absfile] [-c] files [-l library] # -o objfile Override default executable name a.out. # -c Do not call linker, leave relocatables in *.o. # -S leave assembler output on file.s # -l library (passed to ld). # -u complain about undeclared variables # -w omit all warning messages # -w66 omit Fortran 66 compatibility warning messages # files FORTRAN source files ending in .f . # C source files ending in .c . # Assembly language files ending in .s . # efl source files ending in .e . # -D def passed to C compiler (for .c files) # -I includepath passed to C compiler (for .c files) # -Ntnnn allow nnn entries in table t s=/tmp/stderr_$$ t=/tmp/f77_$$.o CC=${CC_f2c:-/bin/cc} EFL=${EFL:-/bin/efl} EFLFLAGS=${EFLFLAGS:-'system=portable deltastno=10'} F2C=${F2C:-f2c} F2CFLAGS=${F2CFLAGS:='-ARw8 -Nn802'} rc=0 trap "rm -f $s $t; exit \$rc" 0 lib=/lib/num/lib.lo OUTF=a.out cOPT=1 CCFLAGS=-DINLINE_MATH while test -n "$1" do case "$1" in -!bs) F2CFLAGS="$F2CFLAGS -!bs" shift ;; -c) cOPT=0 shift ;; -D) CCFLAGS="$CCFLAGS -D$2" shift 2 ;; -g) CFLAGS="$CFLAGS -g" CCFLAGS="$CCFLAGS -g" F2CFLAGS="$F2CFLAGS -g" shift;; -I) CCFLAGS="$CCFLAGS -I$2" shift 2 ;; -o) OUTF=$2 shift 2 ;; -O) CFLAGS="$CFLAGS -O -DINLINE_MATH" shift;; -u) F2CFLAGS="$F2CFLAGS -u" shift ;; -w) F2CFLAGS="$F2CFLAGS -w" case $2 in -6) F2CFLAGS="$F2CFLAGS"66; shift case $2 in -6) shift;; esac;; esac shift ;; -N) F2CFLAGS="$F2CFLAGS $1""$2" shift 2 ;; -S) CFLAGS="$CFLAGS -S" cOPT=0 shift ;; # *.[fF]) case "$1" in *.f) f=".f";; *.F) f=".F";; esac b=`basename $1 $f` $F2C $F2CFLAGS $1 case $? in 0);; *) exit;; esac $CC -c $CFLAGS $b.c 2>$s rc=$? sed '/parameter .* is not referenced/d;/warning: too many parameters/d' $s 1>&2 case $rc in 0);; *) exit;; esac OFILES="$OFILES $b.o" rm $b.c case $cOPT in 1) cOPT=2;; esac shift ;; *.e) b=`basename $1 .e` $EFL $EFLFLAGS $1 >$b.f case $? in 0);; *) exit;; esac $F2C $F2CFLAGS $b.f case $? in 0);; *) exit;; esac $CC -c $CFLAGS $b.c case $? in 0);; *) exit;; esac OFILES="$OFILES $b.o" rm $b.[cf] case $cOPT in 1) cOPT=2;; esac shift ;; *.s) echo $1: 1>&2 OFILE=`basename $1 .s`.o ${AS:-/usr/bin/as} -o $OFILE $AFLAGS $1 case $? in 0);; *) exit;; esac OFILES="$OFILES $OFILE" case $cOPT in 1) cOPT=2;; esac shift ;; *.c) echo $1: 1>&2 OFILE=`basename $1 .c`.o $CC -c $CFLAGS $CCFLAGS $1 rc=$?; case $rc in 0);; *) exit;; esac OFILES="$OFILES $OFILE" case $cOPT in 1) cOPT=2;; esac shift ;; *.o) OFILES="$OFILES $1" case $cOPT in 1) cOPT=2;; esac shift ;; -l) OFILES="$OFILES -l$2" shift 2 case $cOPT in 1) cOPT=2;; esac ;; -l*) OFILES="$OFILES $1" shift case $cOPT in 1) cOPT=2;; esac ;; -o) OUTF=$2; shift 2;; *) OFILES="$OFILES $1" shift case $cOPT in 1) cOPT=2;; esac ;; esac done case $cOPT in 2) $CC -o $OUTF -u _MAIN__ $OFILES -lf2c -lm;; esac rc=$? exit $rc shift ;; -c) cOPT=0 shift ;; -D) CCFLAGS="$CCFLAGS -D$2" shift 2 ;; -g) CFLAGS="$CFLAGS -g" CCFLAGS="$CCFLAGS -g" F2CFLAGS="$F2CFLAGS -g" shift;; -I) CCFLAGS="$CCFLAGS -I$2" shift 2 ;; -o) OUTF=$2 shift 2 ;; -O) CFLAGS="$CFLAGS -O -DINLINE_MATH" shift;; -u) F2CFLAGS="$F2CFLAGS -u" shift ;; -w) F2CFLAGS="$F2CFLAGS -w" case $2 in -pgplot/sys_next/f2c_src/grgenv.c010064400040640000322000000050330567207245000173730ustar00tjpcitmbr00000400000017#include #include /* **GRGENV -- get value of PGPLOT environment parameter (Cray) *+ * SUBROUTINE GRGENV(NAME, VALUE, L) * CHARACTER*(*) NAME, VALUE * INTEGER L * * Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, * environment parameters are UNIX environment variables; e.g. parameter * ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not * recursive and is case-sensitive. * * Arguments: * NAME : (input) the name of the parameter to evaluate. * VALUE : receives the value of the parameter, truncated or extended * with blanks as necessary. If the parameter is undefined, * a blank string is returned. * L : receives the number of characters in VALUE, excluding * trailing blanks. If the parameter is undefined, zero is * returned. *-- * 13-Nov-1994 - [mcs] f2c callable C version for NeXT. *----------------------------------------------------------------------- */ void grgenv_(name, value, length, name_dim, value_dim) char *name, *value; int *length; int name_dim, value_dim; { static char *prefix = "PGPLOT_"; /* Environment variable name prefix */ char test[33]; /* PGPLOT_* Concatenation buffer */ int name_len; /* Un-padded length of 'name' string */ int prefix_len; /* The length of prefix[] */ char *env=0; /* Environment variable value */ int i; /* * Determine the length of 'name' by searching for the last * non-space character. */ name_len = name_dim; while(name_len > 0 && name[name_len-1] == ' ') name_len--; /* * Determine the length of the prefix. */ prefix_len = strlen(prefix); /* * Prefix 'name' with PGPLOT_ if there is room in test[]. */ if(prefix_len + name_len + 1 <= sizeof(test)/sizeof(char)) { strcpy(test, prefix); strncpy(&test[prefix_len], name, name_len); test[prefix_len+name_len] = '\0'; /* * Get the value of the environment variable now named in test[]. */ env = getenv(test); }; /* * Substitute an empty string if no value was obtained, or the value * obtained is too long to fit in the output string. */ if(env==0 || strlen(env) > value_dim) env = ""; /* * Copy the environment variable value into the output string. */ strncpy(value, env, value_dim); /* * Return the unpadded length of the string. */ { int env_len = strlen(env); *length = (env_len <= value_dim) ? env_len : value_dim; }; /* * Pad the fortran string with spaces. */ for(i = *length; i long int groter_(cdev, ldev, cdev_len) char *cdev; long int *ldev; int cdev_len; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * cdev_len I Used by Fortran compiler to pass character length * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } grcter_(fd) int *fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } grwter_(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; long int *lbuf; int cbuf_len; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return * cbuf_len I Used by Fortran compiler to pass character length */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } grpter_(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int cprom_len, cbuf_len; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read * cbuf_len I Used by Fortran compiler to pass character length */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_next/f2c_src/grgetc.c010064400040640000322000000053600567152654400173700ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) grgetc_(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_next/f2c_cc.conf010064400040640000322000000101050656367443600164140ustar00tjpcitmbr00000400000017# The f2c FORTRAN to C compiler and the NeXT cc compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="$SYSDIR/f2c_src/nfc" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -!bs" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -!bs" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lNeXT_s -lsys_s" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/f2c_src" pgplot/sys_next/aaaread.me010064400040640000322000000211350671367357200163310ustar00tjpcitmbr00000400000017NOTE The system support files in this directory (sys_next) are for Nextstep 3.x and earlier. For Openstep 4.x, use the system support files in directory sys_openstep. ------------------------------------------------------------------------ PGPLOT on NeXT Computers Allyn F. Tennant Marshall Space Flight Center 1995-Apr-29 OVERVIEW This directory contains the system dependent routines needed to run PGPLOT on a NeXT computer. Several device handlers will compile and run on the NeXT, allowing those devices to be used as before. Also provided is a PGPLOT viewer program called pgview. Pgview is a stand alone NextStep program that uses interprocess communication to communicate with programs using PGPLOT. This allows pgview to be a full NeXTstep application. Existing PGPLOT programs can use pgview without any modifications, other than being linked with an additional device handler. To use pgview, run the PGPLOT program, and when prompted for a device name, enter /NEXT. If the viewer has been correctly installed, it will automatically launch. The viewer will create a window and display your plot in that window. Using pgview you can create several windows although you can only plot to one window at a time. Any window can be examined, resized, and/or printed after the original PGPLOT program exits. This version of pgview is configured for NextStep 3.x systems. FORTRAN The NeXT computer does not come with a Fortran compiler therefore you must use a third party product. The supplied makefile can be used to compile and run PGPLOT with either the 1) Absoft, 2) Oasys (Green Hill), or 3) f2c compilers. Once you have selected a compiler then read the compiler specific notes for it below. IMPORTANT NOTES FOR f2c compiler The f2c default is to treat backslash characters in strings as escape characters like C, despite the fact this is completely unnecessary, not to mention wrong, in Fortran. The f2c program supports a -!bs switch to turn off this default and this option should be used when compiling the PGPLOT example programs. The fc shell script provided at the archive sites does not correctly deal with this option. In this directory I provide a shell script called nfc which will correctly send -!bs to f2c and not to the C compiler. I've changed the name from fc to nfc (for Next Fortran to C) since fc is the name of a ksh/bash built-in command. IMPORTANT NOTES FOR Green Hill compiler Code compiled with the Oasys compiler cannot read unformatted records longer than 32k bytes. This is a problem for the PGPLOT font file which is currently written as a single record ~67000 bytes long. The default installation with the gf77_cc option, should automatically create a 'grfont.daf' file which is direct access format with a record size that can be read. If PGPLOT detects an filename extension of '.daf' (instead of '.dat') then will automatically assume the font file is direct access and read the file correctly. The pgdemo1 program also causes the a problem with the Oasys compiler. That program contains two routines (besj0 and besj1) that are also in the Oasys supplied library and this prevents the program from linking. Until a better solution is found I suggest editing pgdemo1.f and changing all occurrences of 'besj' to 'xbesj'. IMPORTANT NOTES FOR Absoft compiler The default mode for the Absoft compiler is to be case sensitive. The supplied configuration file and software assume this default. Absoft uses the compiler switch -f to fold routine names into lower case. If you use this switch, you will need to edit some of the C wrappers in sys_next/af77_src directory and change the upper case names to lower case. If you use any of the X11 drivers you should be aware of a bug in the Absoft f77 script. My version of this script reverses the order in which libraries are called before passing the list to the linker. Thus if you use f77 -o pgdemo1 -lpgplot -lX11, the linker will see '-lX11 -lpgplot'. This means that the linker will not be to find any X11 routines called by PGPLOT. The simple solution is to make sure that you always put -lX11 before -lpgplot. Since the makemake script places -lX11 after -lpgplot, you must use a trick to get makemake to get it to generate a makefile that will link the demos. This trick is to edit af77_cc.conf to contain: LIBS="-lX11 libpgplot.a -lNeXT_s -lsys_s" This puts an extra reference to the PGPLOT library into the link command, but it does ensure that linker will search the PGPLOT library before the X11 library. Thanks to Martin Shepherd for suggesting this. X WINDOWS The NeXT computer does not come with an X server, and so if you want to use X you need to obtain a third party product. I've tested PGPLOT with MouseX (the free X Window package), Pencom's demo server, and the eXodus server. In all cases, I've used the MouseX libraries and include files to compile and link. To include X Window drivers in the build, you should first edit the *_cc.conf file for the Fortran compiler that you will use. Where * is either af77, gf77, or f2c. Add -lX11 to the LIBS line as one of the needed libraries. (See Absoft note above.) Although I can get pgdisp and the /XDISP drivers to compile and link, I can not get anything plotted in pgdisp window. Therefore I strongly suggest that you use the /XWIND and/or /XSERVE drivers. You may have minor problems compiling drivers/xwdriv.c and drivers/pgxwin_server.c. both file include which is not on NeXT 3.0 system (newer versions of NeXTStep include this file). If the file is missing then just comment out the include in the source. It is not needed on the NeXT. Also, if the linker complains that the setpgid is not defined in the pgxwin_server program, you should edit pgxwin_server.c and comment out the line: setpgid(0,0); Note, you should not do this unless forced since will couple the server program too closely to the PGPLOT program, i.e., things like aborting the PGPLOT program, via a ^C, may also abort the server. MAKE PGPLOT You should now refer to the standard PGPLOT documentation to create a makefile, and then compile PGPLOT. In brief you will need to create a directory where you can build PGPLOT, create a drivers.list file (make sure you include the NEXT driver!) and then use the $(PGPLOT)/makemake $(PGPLOT) next f2c_cc where $(PGPLOT) is the directory containing the PGPLOT source. Then type make and wait. This will create the library, demos, help files, and the pgview program. If you have asked for the XWIND driver, the pgxwin_server program should also be created. If you install pgview.app into the /LocalApps directory, then PGPLOT will automatically launch it when you plot to the /next device. If pgview is not in LocalApps, then you should launch it by double clicking on it before using /next (although it is possible to start it before the timeout, if you forget). Use the following commands to install: strip pgview.app/pgview cp -pr pgview.app /LocalApps Using 'strip' will reduce the size of the program by a factor 8 and this improves startup time. Useful tips when using pgview Remember that as part of the standard NeXT interface, holding down the alternate key while clicking in the title bar will bring the window to the top without making it key. This is useful when you wish to continue type in terminal window and have the plot window completely visible. Use the main menu to select either a Portrait or Landscape window. Although the window can be resized, PGPLOT produces slightly different output depending on the original aspect ratio of the plot. These aspect ratios were selected to match the aspect ratios of the /PS and /VPS devices. If you start with a Landscape window, then no matter how you resize the window with the resize bar, PGPLOT will still assume the same aspect ratio when drawing. In other words, you first create a plot and then resize window, it will look exactly the same as if you had first first resized the window and then created the plot. When PGPLOT starts, it plots to the most recently active viewer window i.e., the last key window. The viewer will not allow you to change the active plot window while a plot is in progress. BUG REPORTS: The PGPLOT viewer, pgview, was my first NeXT program. Thus I learned about 1) Interprocess communication, 2) the Interface Builder, 3) Objective C and 4) Display Postscript. The viewer still has a few rough edges, but it is usable. Please send bug-reports/suggestions/thank-you notes (but not money) to: Internet: allyn.tennant@msfc.nasa.gov SPAN: SSL::TENNANT Do NOT send NextMail to that address. Like all free support, you get what you pay for. pgplot/sys_next/af77_cc.conf010064400040640000322000000105720656367443600165160ustar00tjpcitmbr00000400000017# The Absoft f77 FORTRAN compiler and the NeXT cc compiler. # There is a bug in the Absoft f77 that reverses the order in which # libraries are passed to the linker. Thus if you use X11 software # the X11 library must be defined before the pgplot library. Using # the following line will allow the pgplot demos to link correctly. # LIBS="-lX11 libpgplot.a -lNeXT_s -lsys_s" #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -DABSOFT" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lNeXT_s -lsys_s" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -DABSOFT -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/af77_src" brary. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="" # Mandatory. # The FORTRAN compiler flags to use when comppgplot/sys_next/gf77_cc.conf010064400040640000322000000100740656367443600165210ustar00tjpcitmbr00000400000017# The Green Hills f77 FORTRAN compiler and the NeXT cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="gf77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -O" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lNeXT_s -lsys_s" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/gf77_src" pgplot/sys_next/g77_cc.conf010064400040640000322000000102270656367443600163530ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and the NeXT cc C compiler. # Experimental: please report problems or fixes. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-fno-backslash -Wimplicit -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash -Wimplicit -O" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lNeXT_s -lsys_s" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/g77_src" GC where needed) FFLAGC="-fno-backslash -Wimplicit -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash -Wimplicit -O" # Mandatory. # The C compiler to use. CCOMPL=pgplot/sys_next/nexsup.m010064400040640000322000000030020567417403000161070ustar00tjpcitmbr00000400000017// This is a 'support routine' used by the nedriv.f code. In brief, this // is the main interface between the Fortran and C languages. It is // called from Fortran and uses an Objective C speaker object to send // messages to the PGPLOT viewer. // #import "pgvSpeaker.h" #import void mkspeak( id * ispeak); id mySpeak=NULL; #ifdef ABSOFT void NEXSUP ( int *ifunc, char *cbuf, float rtmp[], int len_ifunc, int len_cbuf, int len_rtmp) #else void nexsup_( int *ifunc, char *cbuf, float rtmp[], int len_cbuf) #endif { int n1, n2, itmp; double d1, d2; if(mySpeak==NULL) { mkspeak(&mySpeak); } switch (*ifunc) { case 1: [mySpeak getwind: &n1 by: &n2 scale:&d1 color: &itmp]; rtmp[0]= (float) n1; rtmp[1]= (float) n2; rtmp[2]= (float) d1; rtmp[3]= (float) itmp; break; case 2: [mySpeak beginp]; break; case 3: [mySpeak pscode:cbuf]; break; case 4: [mySpeak cursorat: &d1 and: &d2 char: &itmp]; rtmp[0]= (float) d1; rtmp[1]= (float) d2; rtmp[2]= (float) itmp; break; case 5: [mySpeak flush]; break; case 6: [mySpeak endp]; break; case 7: [mySpeak free]; mySpeak=NULL; break; default : printf("nexsup--Unknown function code= %d\n",*ifunc); break; } } #import "mkspeak.m" #import "pgvSpeaker.m" pgplot/pgdispd/aaaread.me010064400040640000322000000277550566772735400161320ustar00tjpcitmbr00000400000017PGDISP for UNIX and VMS X-window Workstations ------------------------------------------------------------------------ PGDISP is a simplified version of the FIGDISP display server, written by Samuel N. Southard, Jr. for use with the FIGARO image-processing package. The following description is extracted from the FIGDISP manual. For more information contact Sam Southard, sns@lo-fan.jpl.nasa.gov. To use the server with PGPLOT, first start PGDISP and then use device type /XDISP in PGPLOT. Before starting pgdisp, the X11 environment must be set up. The X11 environment consists of setting the DISPLAY environment variable appropriately. For example: % setenv DISPLAY :0 or % setenv DISPLAY lo-fan:0.0 The first example would cause the display to appear on the local machine. Other values which can be used to accomplish this are "unix:0.0" and "lhost:0.0", where lhost is the name of the local host. The second example would cause the display to appear on the machine "lo-fan," which could be the either local machine or another machine running an X11 server. Note that the remote machine can be any machine which is running an X11R4 server, not just a Sun. This method is known to work on DECstations. See the X11 documentation for a more detailed description of DISPLAY. Multiple copies of figdisp/pgdisp may be running at any given time. The only limit is your machine's memory. Once the display environment variable set, simply typing the line % pgdisp [options] & will start the display server. The options are optional and are discussed below. If you wish to start up a second copy of pgdisp, type the line % pgdisp -id # [options] & # represents any integer. (Note that there can not be a copy of figdisp and a copy of pgdisp running on the same screen with the same id.) The pgdisp server was designed to address the needs of PGPLOT and supplied everything necessary to do so. It uses a default of 16 colors (2 if on a monochrome screen or it can't get 16 colors for some reason), but this can be changed with the lineColors resource. See the section on Color Allocation for a description of how this works. The only other feature provided is a cursor. This is sufficient to support all PGPLOT requirements. The pgdisp window can be resized arbitrarily. The initial size is determined by the figdisp.lg.geometry resource. Since PGPLOT automatically scales to use the entire window, the pgdisp window should not be resized while a program is accessing it. If this is done, the display server will not crash, but the output will look odd. The pgdisp window title is updated to show the position of the cursor when the cursor is in the pgdisp window. Color Allocation Pgdisp tries to avoid flashing when moving to and from its windows. At the same time, pgdisp tries to use as many colors as the user likes, and it may need to use a private color map to do so. When it is using a private color map, the correct colors will be displayed only when the cursor is in the figdisp window. For more information, see the FIGDISP manual. The pgdisp window is cleared when pgdisp begins. The first 16 LUT table entries (or as many of them as possible, if the user requested fewer than 16 colors) are set as specified in table 2 (possible values range from 0 to 65535). If the line graphics window is using more than 16 colors, the colors above index 15 are initialized to a greyscale with data value 15 corresponding to black (for the purposes of the greyscale - data value 15 is still assigned as specified in table 2) and the maximum data value corresponding to white. If line graphics are attempted on a greyscale screen, all color components are set to the same value, specifically 0.30*red+ 0.59*green+0.11*blue, where red, green, and blue are the requested values. Color Index Red Component Green Component Blue Component -------------------------------------------------------------- 0 0 0 0 1 65535 65535 65535 2 65535 0 0 3 0 65535 0 4 0 0 65535 5 0 65535 65535 6 65535 0 65535 7 65535 65535 0 8 65535 32768 0 9 32768 65535 0 10 0 65535 32768 11 0 32768 65535 12 32768 0 65535 13 65535 0 32768 14 21845 21845 21845 15 43690 43690 43690 Table 2. Pgdisp line graphics initial color map entries. Window Managers Pgdisp has two aspects which cause its behavior to depend on the window manager. The first of these is how pgdisp decide which color map to use and has already been discussed. The second is the extensive use of the mouse buttons, which interacts with how the window manager determines input focus. Most window managers have two methods of determining which window gets input focus: click-to-type, in which the user must click on the window he wants to get input, and follow-pointer, in which the window under the pointer gets input. If the user has specified click-to-type, before he can pan the image, manipulate the LUTs, or any other mouse controlled function, he must click on the figdisp window. If this click is done inside the figdisp window, instead of on the border, figdisp will also get this click and will processes it, which will result in the image being panned (if the left mouse button is used). There are at least two ways around this. The first is to use follow-pointer focus. The way to do this varies from window manager to window manager. For the OpenLook Window Manager, the line OpenWindows.SetInput: followmouse should be placed into the user's ~/.Xdefaults file or olwm should be started with the -f or -follow flag. For the Motif window manager, the line Mwm*keyboardFocusPolicy: pointer accomplishes the same thing. The second way to prevent unwanted panning in figdisp is by telling the window manager not to pass the select event (clicking on the window) to the program (figdisp). This is accomplished in the Motif window manager by adding the line Mwm*passSelectButton: false to the user's ~/.Xdefaults file. Note that for changes to the .Xdefaults file to take affect, the resource database must be updated and the window manager must be re-started. The easiest way to do this is to exit X windows and start it up again. Customizing Figdisp Figdisp allows the user to customize everything about how it interacts with the user. Table 3 contains the list of command line options and the corresponding X resources that figdisp recognizes. Every resource is prefaced by the name of the program (i.e. a listing of .display means the resource is figdisp.display if the program was started up as figdisp or and pgdisp.display if the program was started up as pgdisp). A detailed discussion of the effects of each of these resources has been given in preceeding sections. Command Line Option X resource Default Notes ------------------------------------------------------------------------------- -display disp .display none The display on which the display server should run. -id # .id 0 The id number of this copy of figdisp or pgdisp. An arbitrary number of copies of figdisp/pgdisp may be run at the same time, as long as each one's id number is unique. -geometry WxH[+x+y] 512x512 This flag corresponds to .bm.geometry in figdisp and .lg.geometry in pgdisp -lgGeometry WxH[+x+y] .lg.geometry 512x512 The line graphics window geometry. -lineColors # .lineColors 16 The number of colors to use for line graphics. -visual .visual Any The visual to use. Accepted values include the X11 visuals PseudoColor and GrayScale, as well as Default (only the default visual is allowed) and Any (any visual is allowed) for either pgdisp or figdisp. Pgdisp also allows the X11 visual classes StaticGray, StaticColor, DirectColor, and TrueColor. -help .showhelp True Whether or not an initial help -nohelp screen should be displayed. Table 3. Pgdisp command line options and resources If you are already familiar with X resources, Table 2, plus the meaning of all the resources, which can be found earlier in this document, is all you need to know. If not, continue reading. Figdisp looks for its resource values in the following places (precedence is from top to bottom): The command line The XENVIRONMENT or ~/.hostname files The server resource database (the xrdb command) or the ~/.Xdefaults file The Figdisp or Pgdisp file in XAPPLRESDIR or /usr/lib/X11/app-defaults The compile time defaults. You should note that because of this precedence, the defaults specified by your system manager in the Figdisp or Pgdisp file will take priority over the compile-time defaults, so the listed default values may not agree with those on your system. Customizing Pgdisp with Command-Line Options The easiest way to experiment with figdisp's options is to use the command line. Doing this is as simple as looking up the command-line option which corresponds to the resource you want to specify, and then using it on the command line. For example, changing the key used to exit figdisp to "q" is as simple as % figdisp -quit q & Some figdisp command-line options do not require an argument. For example, let's say that in addition to changing the quit key, you wanted to disable the initial message figdisp produces referring you to this manual and to the help key. You would do this by the command % figdisp -quit q -nohelp & Now let's say that in addition to all of the above, you wanted to specify that the bitmap graphics window started out 256 pixels wide, 512 pixels tall, 100 pixels from the left edge of the screen, and 200 pixels from the top edge of the screen, the line graphics window to start out 512 pixels wide and 256 pixels high (but didn't care where on the screen it appeared), the font used for labels to be 5x8 (a very small font), PostScript output to go to the file ~/fdout.ps, the display server to try to allocate a maximum of 128 colors and a minimum of 100 colors in the default color map, and the display server to exit if it has to allocate a private color map. This would take the command % figdisp -quit q -nohelp -bmGeometry 256x512+100+200 -lgGeometry 512x256 \ -font 5x8 -psFile ~/fdout.ps -colors 128 -minColors 100 \ -maxPrivateColors 1 -minPrivateColors 2 & Since the minimum number of colors allowable in the private color map is less than the maximum, figdisp will never use a private color map. This technique can also be used to require figdisp to use a private color map. Note that the options can come in any order and the flags can be abbreviated to the smallest unique string, so the last command could also be % figdisp -minP 2 -maxP 1 -minC 100 -colo 128 -ps ~/fdout.ps -fon 5x8 \ -lg 512x256 -bm 256x512+100+200 -noh -q q & As was mentioned in Starting Figdisp, if you are using Figaro figdisp has been aliased so that you do not need to specify the "&" to start figdisp in the background. Customizing Figdisp with your ~/.Xdefaults file As you no doubt realized, typing in a long command line as in the final example can get to be very awkward. This is where the server resource database (which is usually read from the ~/.Xdefaults file using the command xrdb, usually located in ~/.xinitrc) comes in handy. The .Xdefaults file has the same format as all the other resource files listed (XENVIRONMENT, /usr/lib/X11/app-defaults/Figdisp, etc), so this section applies to them as well. Assume that you had decided that the final example in the previous section was how you wanted figdisp to start up. You would then edit your ~/.Xdefaults file to include the lines: figdisp.quit: q figdisp.showhelp: False figdisp.bm.geometry: 256x512+100+200 figdisp.lg.geometry: 512x256 figdisp.font: 5x8 figdisp.psFile: ~/fdout.ps figdisp.bm.maxcolors: 128 figdisp.bm.mincolors: 100 figdisp.bm.private.maxcolors: 1 figdisp.bm.private.mincolors: 2 If your server has a server resource database, you would need to update it by either re-starting X windows or using the xrdb command. Once this was done, figdisp would automatically come up as if you had typed in all those options. You could still override your choices by using a command line option. pgplot/pgdispd/cleanup.c010064400040640000322000000016730537332240100157650ustar00tjpcitmbr00000400000017/* The cleanup routine cleans up everything necessary to shut down the */ /* FIGARO/PGPLOT display server nicely. */ /* Sam Southard, Jr. */ /* Created: 11-Nov-1990 */ /* 10-Dec-1990 SNS/CIT Modified to use wininfo structure */ /* 10-May-1991 SNS/CIT Modified to live with Lick's Xvideo */ /* 7-Aug-1991 SNS/CIT Now deals with OpenWindows bug. */ /* 15-Aug-1991 SNS/CIT No longer includes vista hooks. */ /* 8-Oct-1991 SNS/CIT Modified for cleaner wininfo struct */ /* The X Window include files */ #include /* The program include files */ #include "figdisp.h" #include "globals.h" void cleanup() { void restorecolors(); #ifndef PGDISP #ifndef UNBUGGY /* deal with OpenWindows bug an restore the color maps to what they */ /* used to be */ restorecolors(); #endif #endif /* Release the line graphics graphics context */ XFreeGC(display,linegc); /* shut down this channel to the display */ XCloseDisplay(display); return; } pgplot/pgdispd/commands.h010064400040640000322000000420170562620720200161430ustar00tjpcitmbr00000400000017/* This file contains the definitions (and formats) for the command types, */ /* as well as any other constants needed for programs which access the */ /* Figaro/PGPLOT X Window display server. It should be included by any */ /* program which accesses the Figaro/PGPLOT X Window display server. All */ /* arguments are short (16-bit) except for the pixel values for the bitmap */ /* write command. If an odd number of pixels is written in the bitmap write */ /* command, the next command must be aligned on the next half-word (16-bit) */ /* boundary. Note that all points are given from the top left corner of the */ /* PIXMAP, not the window. This is so the point specification never changes */ /* no matter what is done to the window size. Only one command which returns */ /* a value to the requesting program (TOK_LG_MAX_DIM, for example) is allowed */ /* in a single transfer. If more than one are specified the final request is */ /* honored. The command does not need to be the last command in a sequence. */ /* A call to TOK_SET_LG_SIZE must not precede TOK_LG_DEF_SIZE in a command */ /* buffer. If it does, the old size of the window MAY (not will) be */ /* returned. */ /* Sam Southard, Jr. */ /* Created: 2-Nov-1990 */ /* 8-Nov-1990 SNS/CIT NAME_PROG, NAME_INCRATOM, NAME_DATAATOM, and */ /* NAME_SELATOM added. */ /* 14-Nov-1990 SNS/CIT TOK_DRAW_LINE now takes four arguments. */ /* TOK_DRAW_POLY no longer uses the curent cursor */ /* location as a starting point. TOK_LG_MAX_DIM through */ /* TOK_FILL_RECT added. */ /* 15-Nov-1990 SNS/CIT All commands except the bitmap-write (not added yet) */ /* modified to accept all short arguments. */ /* 19-Nov-1990 SNS/CIT TOK_SET_LG_CURS and TOK_LG_GET_CURS combined into */ /* TOK_LG_CURS. */ /* 20-Nov-1990 SNS/CIT TOK_LG_LINE_WID added. */ /* 12-Dec-1990 SNS/CIT TOK_SHOW_BM_WIN through TOK_SET_BM_SIZE added. */ /* 17-Dec-1990 SNS/CIT TOK_SET_BM_LUT description changed for better PGPLOT */ /* support. TOK_SET_BM_LUT and TOK_SET_LG_LUT now */ /* function differently, which should be changed in the */ /* future. */ /* 18-Dec-1990 SNS/CIT TOK_BM_CURS split into TOK_BM_SET_CURS and */ /* TOK_BM_GET_CURS for easier TVPCKG interface. */ /* 22-Apr-1991 SNS/CIT TOK_SET_BM_CSCALE and TOK_SET_BM_DSCALE added. */ /* 29-Apr-1991 SNS/CIT TOK_BM_ZOOMPAN added. */ /* 17-Jun-1991 SNS/CIT TOK_BM_FLUSH added. */ /* 1-Aug-1991 SNS/CIT TOM_BM_LINE added. */ /* 14-Aug-1991 SNS/CIT Commands no longer begin with TOK_ */ /* 20-Aug-1991 SNS/CIT COMBUFLEN no longer needed. */ /* 17-Oct-1991 SNS/CIT SET_BM_SIZE and BM_WRITE now take the number of bits */ /* in a pixel */ /* 26-Feb-1992 SNS/CIT LG_PIXLINE and SET_LG_CSCALE added */ /* 25-Jun-1992 SNS/CIT SET_BM_LUT now takes the number of bits in a pixel. */ /* 9-Jul-1992 SNS/CIT Argument definitions for SET_BM_SIZE and SET_LG_SIZE */ /* reconciled. They now both take the new size, while */ /* SET_LG_LUT had been taking the maximum coordinates */ /* and the comments in this file claimed that both of */ /* them took the maximum coordinates. */ /* 22-Sep-1992 SNS/CIT special value definition added to BM_ZOOMPAN comment. */ /* Added definitions of SET_BM_SH_SIZE and BM_SH_UPDATE. */ /* 23-Sep-1992 SNS/CIT SET_BM_DSCALE changed to use ASCII strings. */ /* 27-Sep-1992 SNS/CIT SET_LG_CSCALE changed to use ASCII strings. */ /* 5-Oct-1992 ARC/HI Added DO_BOX and DO_AUTOSCALE commands. */ /* 14-Oct-1992 SNS/CIT RCS id string now added if INC_HEADER_RCS #define'd. */ /* Now protected from double inclusion */ /* 4-Nov-1992 SNS/CIT AUTOSCALE now takes ASCII-encoded floats which range */ /* from 0.0 to 100.0 */ #ifndef INC_COMMANDS_H #define INC_COMMANDS_H #ifndef lint #ifdef INC_HEADER_RCS static char commands_h_rcsid[]="@(#)$Id: commands.h,v 1.13 1994/02/07 04:33:26 figaro Exp $"; #endif #endif /* some constants needed for programs accessing the display server */ #define NAME_PROG "figdisp" /* The name of the program. It is used to */ /* ensure that only one copy of the program */ /* is running on each screen. */ #define NAME_INCRATOM "figdispincr" /* The name of the incremental atom */ #define NAME_DATAATOM "figdispdata" /* The name of the data atom */ #define NAME_SELATOM "figdispsel" /* The name of the selection atom */ /* The command tokens */ #define RESET 0 /* reset the server. Does not clear either */ /* the line or bitmap graphics screens. Sets */ /* the line graphics line characteristics and */ /* the line graphics LUTs to their default */ /* states. */ #define SHOW_LG_WIN 1 /* takes one argument: 0 means hide the line */ /* graphics window, anything else means show */ /* the line graphics window */ #define SET_LG_LUT 2 /* set the line graphics look up tables. The */ /* first argument is the starting LUT entry, */ /* the next argument is the number of entries */ /* to change, and the remaining arguments are */ /* red, green, and blue (in that order) */ /* values for the LUT entries */ #define LG_CURS 3 /* set and return the line graphics cursor */ /* location. The first argument is the */ /* number of pixels from the left side of the */ /* image. The second is the number of pixels */ /* from the top of the screen. Once a key */ /* has been pressed or a mouse button */ /* clicked, three short elements are */ /* returned. The first two are the position */ /* of the cursor. The third element is the */ /* key or button that was pressed. The high */ /* byte is 0 if a key was pressed and non- */ /* zero if a button was clicked. If a button */ /* was pressed the second byte is the number */ /* of the button which was pressed, from left */ /* to right with 0 being the left-most */ /* button. If a key was pressed the second */ /* byte is the ASCII code of the */ /* corresponding character. */ #define SET_LG_COL 4 /* set the color index for the line graphics */ /* The only argument is the color index to */ /* use. Only the lower 4 bits of the */ /* argument are relevant. */ #define DRAW_LINE 5 /* draw a line from the position specified */ /* by the x and y coordinates of the first */ /* points and the x and y coordinates of the */ /* second point. */ #define DRAW_POLY 6 /* draw a poly-line. The first argument is */ /* the number of points. The remaining */ /* arguments are X,Y pairs in the format of */ /* the DRAW_LINE command. */ #define CLR_LG_WIN 7 /* clear the line graphics window */ #define LG_MAX_DIM 8 /* Get the line graphics window maximum */ /* This returns all information required for */ /* OPCODE 2 in PGPLOT. The first four */ /* elements the minimum and maximum x values */ /* and the mimumum and maximum y values. The */ /* next two elements are the minimum and */ /* maximum allowed color indices */ #define LG_SCALE 9 /* Returns information required for OPCODE 3 */ /* in PGPLOT. The elements are the width and */ /* height of the screen in millimeters and */ /* The width and height of the screen in */ /* pixels. */ #define LG_DEF_SIZE 10 /* Returns the default display size, which is */ /* the current window size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the window. */ #define SET_LG_SIZE 11 /* Sets the size of the line graphics window. */ /* The arguments to this command are the new */ /* x and y sizes. If they exceed the */ /* compile-time maximums or are less than the */ /* compile-time minimums the compile time */ /* values are used instead. */ #define DRAW_DOT 12 /* draw a dot at the specified X,Y location. */ #define FILL_POLY 13 /* Draw a filled polygon. The first argument */ /* is the number of points in the polygon. */ /* The remaining arguments are the X,Y */ /* points. */ #define FILL_RECT 14 /* Draw a filled retangle. The first two */ /* arguments are the X,Y coordinates of the */ /* lower left point and the next two points */ /* are the X,Y coordinates of the upper right */ /* point. */ #define LG_LINE_WID 15 /* set the line width. The argument is the */ /* number of pixels the line width should be */ #define SHOW_BM_WIN 16 /* takes one argument: 0 means hide the */ /* bitmap graphics window, anything else */ /* means show the bitmap graphics window */ #define SET_BM_LUT 17 /* set the bitmap graphics look up tables. */ /* The first argument is the number of bits */ /* used to number the LUT entries (e.g. 8 if */ /* there are 256 LUT entries and 16 if there */ /* are 65536 LUT entries. The next */ /* arguments are the starting LUT entry, the */ /* number of entries to change, and the */ /* fourth argument is a bitfield representing */ /* the LUTs to change. If the fourth */ /* argument is 0 than the all the LUTs are */ /* affected and the remaining arguments are */ /* red, green, and blue (in that order) */ /* values for the LUT entries. If the fourth */ /* argument is 1 than only the red values are */ /* affected, if it is 2 than the green values */ /* are affected, and if it is 4 than the blue */ /* values are affected. If it is a */ /* combination of 1, 2, and 4 than each of */ /* values is used for all appropriate LUTs. */ /* For example, if the sequence was 3 */ /* followed by 15 than both the red and green */ /* LUT values would be set to 15. Note that */ /* this is very different from the */ /* interpretation of SET_LG_LUT. */ #define BM_SET_CURS 18 /* Set the current cursor location. This has */ /* no visible effect until BM_GET_CURS */ /* is sent, when the window is raied and the */ /* pointer is warped to the appropriate */ /* place. Takes two arguments, the X and Y */ /* coordinates of the cursor. */ #define BM_GET_CURS 19 /* return the bitmap graphics cursor */ /* location. The return values are the same */ /* as LG_CURS. */ #define CLR_BM_WIN 20 /* clear the bitmap graphics window */ #define BM_MAX_DIM 21 /* Get the bitmap graphics window maximum */ /* The first four elements the minimum and */ /* maximum x values and the mimumum and */ /* maximum y values. The next two elements */ /* are the minimum and maximum allowed color */ /* indices */ #define BM_DEF_SIZE 22 /* Returns the default display size, which is */ /* the current image size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the image. */ #define SET_BM_SIZE 23 /* Sets the size of the bitmap graphics */ /* window. The arguments to this command are */ /* the new x and y sizes and the new number */ /* of bits in a pixel (8 or 16). If they */ /* exceed the compile-time maximums or are */ /* less than the compile-time minimums the */ /* compile time values are used instead. */ #define BM_WRITE 24 /* write a bitmap to the bitmap image. This */ /* command takes a varying number of */ /* arguments. The first argument is the */ /* number of bits in a pixel (8 or 16). The */ /* next two arguments are the X and Y */ /* coordinates of the upper left corner of */ /* the area to be affected. The next two */ /* arguments are the width and height of the */ /* affected area. The remaining arguments */ /* are the data values. If there are 8 bits */ /* per pixels the data values are all chars. */ /* If the data for this command is split up */ /* between more than one X transfers, than */ /* all but the last transfer must have an */ /* even number of bytes. The last transfer */ /* may have an odd number if necessary. Note */ /* this this is automatically taken care of */ /* if there are 16 bits per pixel. */ #define SET_BM_CSCALE 25 /* Set the X and Y scaling and offset values */ /* so that the built-in cursor can be used. */ /* The arguments to this command are the x */ /* multiplier, the x divisor, the x offset, */ /* the y multiplier, the y divisor, and the */ /* y offset. See the documentation for */ /* further details */ /* scaling factors and adding the offsets. */ #define SET_BM_DSCALE 26 /* Set the data scaling and offset values */ /* so that the built-in cursor can be used. */ /* This command takes two ASCII strings as */ /* arguments, both NULL terminated and in the */ /* %g format (from printf). They are the */ /* scaling factor and the offset to apply to */ /* the data. See the documentation for */ /* further details. */ #define BM_ZOOMPAN 27 /* Set the zoom factor. The first two */ /* arguments are the X and Y coordinates for */ /* the new center of the displayed portion, */ /* and the next two arguments are the power */ /* of two for X & Y to zoom to. Setting the */ /* X or Y coordinate (or both) to -1 leaves */ /* the center of the displayed image as is. */ /* Setting either of the the zoom factors to */ /* a value greater than 30 leaves them as is. */ #define BM_FLUSH 28 /* flush all commands to the screen */ #define BM_LINE 29 /* Draw a line in the bitmap graphics area. */ /* The arguments to this command are the */ /* number of bits per pixel used for the */ /* data value, X & Y coordinates of the two */ /* points (x1, y1, x2, y2) followed by the */ /* data value (0-255 or 0-65535) to use to */ /* draw the line. */ #define LG_PIXLINE 30 /* Draw a line of pixels into the line */ /* graphics windows (PGPLOT opcode 26). The */ /* arguments to this command are the number */ /* of pixels, the starting X and Y */ /* coordinates, and the list of pixels */ #define SET_LG_CSCALE 31 /* Set the line graphics cursor scale so that */ /* the built-in cursor can be used. The four */ /* arguments to this command are the NULL- */ /* terminated ASCII strings in the %g format */ /* (see printf). They are the X offset and */ /* scaling factor followed by the Y values. */ /* See the documentation for further details. */ #define SET_BM_SH_SIZE 32 /* Sets the size of the bitmap graphics */ /* window and uses data from a shared memory */ /* buffer. The arguments to this command are */ /* the new x and y sizes, the new number of */ /* bits in a pixel (8 or 16), the type of */ /* shared memory to use, and a variable */ /* number of other parameters, depending on */ /* the type of shared memory being used. The */ /* shared memory type is very system */ /* dependant. So far the following types, */ /* with the mentioned arguments, are */ /* defined: */ /* Type 1: SunOS 4.1.2 shmget-type. */ /* This type has an extra two argument, the */ /* high 16-bit word of the shared memory */ /* identifier suitable for use with the shmat */ /* call and the low 16-bit word. This */ /* command also returns a two parameter */ /* buffer, the first word of which is */ /* SET_BM_SH_SIZE and the second of which is */ /* 1 if the shared memory mapping was */ /* successful and 0 if it was not. If this */ /* command is not successful, the SET_BM_SIZE */ /* command should be used. See the */ /* programmer's manual for more information */ /* on this command. */ #define BM_SH_UPDATE 33 /* This command tells figdisp to update */ /* internal structures (such as windows) */ /* based on the changed contents of the */ /* shared memory area from SET_BM_SH_SIZE. */ /* The first two arguments are the X and Y */ /* coordinates of the upper left corner of */ /* the area to be affected. The next two */ /* arguments are the width and height of the */ /* affected area. This command is a shared */ /* memory version of the BM_WRITE command and */ /* only works after a SET_BM_SH_SIZE command */ /* has completed successfully since the last */ /* time the the SET_BM_SIZE command was used */ /* (it is ignored otherwise). The BM_WRITE */ /* command may also be used with shared */ /* memory images, but it is not as fast. */ #define DO_BOX 34 /* Compute image statistics within the user */ /* defined rectangle. This command has no */ /* arguments. */ #define DO_AUTODISP 35 /* Linear ramp between percantile range. The */ /* arguments to this command are the two */ /* ASCII strings, the lower and upper bounds */ /* percentiles (between 0.0 and 100.0) to be */ /* used to scale data. */ #define DO_HISTEQ 36 /* Histogram Equalization */ #define FIGDISP_IDLE 37 /* This command returns itself when figdisp */ /* is idle. It is useful for synchronizing */ /* commands, such as CLR_BM_WIN and BM_LINE, */ /* which cause the figdisp program to alter */ /* the image data. If this is not used when */ /* shared memory is in use, the image could */ /* get corrupted. */ #define FIGDISP_POINTS 38 /* This command takes the number of points, */ /* then the number of bits per pixel, then */ /* numpoints triplets of x, y, and value. */ #endif /* INC_COMMANDS_H */ _DEF_SIZE 10 /* Returns the default display size, which is */ /* the current window size. The elements of */ /* this command are the current minimum and */ /* maximum x values and the current minimum */ /* and maximum y values for the window. */ #define SET_LG_SIZE 11 /* Sets the size of the line graphics window. */ /* The arguments to this command are the new */ /* x and y sizes. If they exceed the */ /* compile-time maximums or are less than the */ /* compipgplot/pgdispd/exposelgwin.c010064400040640000322000000017240537332240300167010ustar00tjpcitmbr00000400000017/* The exposelgwin routine handles an expose event on the line graphics */ /* window. The argument is the expose event. */ /* Sam Southard, Jr. */ /* Created: 29-Mar-1991 (from figdisp/exposewin) */ /* Modification History: */ /* 2-Apr-1991 SNS/CIT Pixmap and window are now the same size. */ /* 15-Aug-1991 SNS/CIT No longer includes hooks for xvideo */ /* 8-Oct-1991 SNS/CIT Globals moved to globals.h */ /* 10-Oct-1991 SNS/CIT Now handles winxoff & winyoff */ /* 14-Oct-1992 SNS/CIT Now flushs the X connection. RCS id string added. */ #ifndef lint static char rcsid[]="@(#)$Id: exposelgwin.c,v 1.4 1992/10/19 02:14:16 figaro Exp $"; #endif /* The program include files */ #include "figdisp.h" #include "globals.h" void exposelgwin(event) XExposeEvent event; { /* pretty simple */ XCopyArea(display, lg.pixmap, lg.win, linegc, event.x-lg.winxoff, event.y-lg.winyoff, (unsigned)event.width, (unsigned)event.height, event.x, event.y); XFlush(display); return; } pgplot/pgdispd/figcurs.c010064400040640000322000000177030547645165400160220ustar00tjpcitmbr00000400000017/* The routines in this file control the cursor access (setting and getting) */ /* for the Figaro server version of the vista display server. */ /* Sam Southard, Jr. */ /* Created: 20-Apr-1991 */ /* Modification History: */ /* 25-Apr-1991 SNS/CIT clearcurs routine added. */ /* 10-May-1991 SNS/CIT Modified to be shared between Xvideo and PGDISP */ /* 11-Aug-1991 SNS/CIT xvideo hooks removed */ /* 5-Sep-1991 SNS/CIT Modified to lint cleanly */ /* 8-Oct-1991 SNS/CIT Globals moved to globals.h */ /* 17-Oct-1991 SNS/CIT Modified to deal with 8 and 16 bit images */ /* 27-Nov-1991 SNS/CIT malloc.h include deleted to make everyone happy */ /* 9-Jul-1992 SNS/CIT Addkeyval and Addbuttonval modified to return 0 if a */ /* modified key is pressed (so it's not recorded). */ /* They were also renamed to getkeyval and ... */ /* 27-Sep-1992 SNS/CIT Now puts the cursor event in the buffer in network */ /* byte order. */ /* The standard include files */ #include #include #include /* The X Window include files */ #include #include #include /* The program include files */ #include "figdisp.h" #include "globals.h" struct curpos { short x; /* x position */ short y; /* y position */ short val; /* the value of the button/key pressed. */ struct curpos *next; /* the next position */ }; static struct curpos *lgcurses=NULL; /* the line graphics cursor events */ static struct curpos *lastlg=NULL; /* last in list of line graphics */ static int lgx,lgy; /* line graphics cursor location */ #ifndef PGDISP static struct curpos *bmcurses=NULL; /* the bitmap graphics cursor events */ static struct curpos *lastbm=NULL; /* last in list of bitmap graphics */ static int bmx,bmy; /* bitmap graphics cursor location */ #endif /* The pggcurs and bmcurs routines get the first cursor event in the line */ /* graphics or bitmap graphics list and returns it in the buffer buf, which */ /* has the format for the BM_GET_CURS and LG_CURS commands. */ /* Return Values: */ /* Whatever getcurs returns */ int pggcurs(buf) short *buf; { int getcurs (); return(getcurs(buf,&lgcurses,&lastlg)); } #ifndef PGDISP int bmgcurs(buf) short *buf; { int getcurs (); return(getcurs(buf,&bmcurses,&lastbm)); } #endif /* The getcurs routine gets the first cursor point from the given list, */ /* updates the buffer accordingly, and updates the given pointer. */ /* Return Values: */ /* 0 There are no cursor positions to return */ /* 1 The buffer was set properly */ int getcurs(buf,curlist,listend) short *buf; struct curpos **curlist; struct curpos **listend; { struct curpos *tmpptr; /* the cursor hasn't yet been set */ if (*curlist == NULL) return(0); /* get the data */ buf[1]= htons((*curlist)->x); buf[2]= htons((*curlist)->y); buf[3]= htons((*curlist)->val); /* free up the used cursor point */ tmpptr= *curlist; if ((*curlist= (*curlist)->next) == NULL) *listend=NULL; free((char *)tmpptr); return(1); } /* The pgcursor routine adds the specified event to the list of cursor events */ /* on the line graphics window. */ /* Return Value: 1 (no matter what) */ int pgcursor(event) XEvent event; { short val; /* the "value" of the event" */ void getbuttonval(); int getkeyval(); char *malloc(); if (event.type == ButtonPress) getbuttonval(event.xbutton.button, &val); else if (!getkeyval(event, &val)) return(1); if (lastlg != NULL) { /* if we can't get space for the next one */ #ifdef lint if (malloc(sizeof(struct curpos)) == NULL) #else if ((lastlg->next=(struct curpos *)malloc( sizeof(struct curpos))) == NULL) #endif return(1); lastlg=lastlg->next; } else { /* This is the first one */ #ifdef lint if (malloc(sizeof(struct curpos)) == NULL) #else if ((lgcurses=(struct curpos *)malloc(sizeof(struct curpos))) == NULL) #endif return(1); lastlg=lgcurses; } lastlg->next=NULL; /* no translations are needed on the line graphics window */ if (event.type == ButtonPress) { lgx=lastlg->x = event.xbutton.x; lgy=lastlg->y = event.xbutton.y; } else { lgx=lastlg->x = event.xkey.x; lgy=lastlg->y = event.xkey.y; } lastlg->val=val; return(1); } #ifndef PGDISP /* The bmcursor routine adds the specified event to the list of cursor events */ /* on the bitmap graphics window. */ /* Return Value: 1 (no matter what) */ int bmcursor(event) XEvent event; { short val; /* The value associated with the cursor event */ void getbuttonval(); int getkeyval(); char *malloc(); if (event.type == ButtonPress) getbuttonval(event.xbutton.button, &val); else if (!getkeyval(event, &val)) return(1); if (lastbm != NULL) { /* if we can't get space for the next one */ #ifdef lint if (malloc(sizeof(struct curpos)) == NULL) #else if ((lastbm->next=(struct curpos *)malloc( sizeof(struct curpos))) == NULL) #endif return(1); lastbm=lastbm->next; } else { /* This is the first one */ #ifdef lint if (malloc(sizeof(struct curpos)) == NULL) #else if ((bmcurses=(struct curpos *)malloc(sizeof(struct curpos))) == NULL) #endif return(1); lastbm=bmcurses; } lastbm->next=NULL; /* translations are needed on the bitmap graphics window */ if (event.type == ButtonPress) { bmx=lastbm->x = display_to_imagecol(event.xbutton.x); bmy=lastbm->y = display_to_imagerow(event.xbutton.y); } else { bmx=lastbm->x = display_to_imagecol(event.xkey.x); bmy=lastbm->y = display_to_imagerow(event.xkey.y); } lastbm->val=val; return(1); } #endif /* The getbuttonval routine updates val to correspond to the appropriate */ /* keypress. */ void getbuttonval(button,val) unsigned int button; short *val; { switch(button) { case Button1: *val=0x0100; break; case Button2: *val=0x0101; break; case Button3: *val=0x0102; break; case Button4: *val=0x0103; break; default: *val=0x0104; break; } return; } /* The getkeyval routine updates val to correspond to the appropriate */ /* keypress */ /* Return Values: */ /* 0 A modifier key was pressed */ /* 1 A regular key was pressed */ int getkeyval(event,val) XEvent event; short *val; { char tmpchr; KeySym keysym; (void)XLookupString((XKeyEvent *)&event,&tmpchr,1,&keysym, (XComposeStatus *)NULL); if ((keysym >= XK_Shift_L) && (keysym <= XK_Hyper_R)) return(0); *val=tmpchr; return(1); } /* The pgscurs routine sets the current line graphics cursor position. Note */ /* that this does not do anything unless there are no entries in the list of */ /* cursor events and does not do anything visible unless this position is */ /* different than the previousrecorded line graphics cursor location. */ void pgscurs(x,y) int x,y; { if (lgcurses != NULL) return; /* is this different enough to warp the cursor */ if (x+1 < lgx || x-1 > lgx || y-1 > lgy || y+1 < lgy) XWarpPointer(display,None,lg.win,0,0,0,0,x,y); lgx=x; lgy=y; return; } #ifndef PGDISP /* The bmscurs routine sets the current bitmap graphics cursor position. */ /* Note that this does not do anything unless there are no entries in the */ /* list of cursor events and does not do anything visible unless this */ /* position is different than the previous recorded line graphics cursor */ /* location. */ void bmscurs(x,y) int x,y; { if (bmcurses != NULL) return; /* is this different enough to warp the cursor */ if ((x+1 < bmx || x-1 > bmx || y-1 > bmy || y+1 < bmy) && imagecol_to_display(x) >= 0 && imagecol_to_display(x) < bm.width && imagerow_to_display(y) >= 0 && imagerow_to_display(y) < bm.height) XWarpPointer(display,None,bm.win,0,0,0,0, imagecol_to_display(x),imagerow_to_display(y)); bmx=x; bmy=y; return; } #endif /* The clearcurs routine clears all the cursor events from both lists. */ void clearcurs() { struct curpos *tmpptr; while (lgcurses != NULL) { tmpptr=lgcurses->next; free((char *)lgcurses); lgcurses=tmpptr; } #ifndef PGDISP while (bmcurses != NULL) { tmpptr=bmcurses->next; free((char *)bmcurses); bmcurses=tmpptr; } lastbm=NULL; bmx=bmy= -1; #endif lastlg=NULL; lgx=lgy -1; return; } pgplot/pgdispd/figdisp.h010064400040640000322000000330520537332240400157670ustar00tjpcitmbr00000400000017/* This file contains some general definitions for the Figaro/PGPLOT X Window */ /* display server. */ /* Sam Southard, Jr. */ /* Created: 6-Nov-1990 */ /* 7-Nov-1990 SNS/CIT Added default values */ /* 8-Nov-1990 SNS/CIT Added LG_WIN_DEPTH, MAXSTRLEN, MALLOC_ERR, BADCOM, */ /* and INCCOM */ /* 16-Nov-1990 SNS/CIT Added LG_MAX_HEIGHT and LG_MAX_WIDTH. */ /* 10-Dec-1990 SNS/CIT wininfo struct added. VMS changes merged in. */ /* LG_DEPTH changed to LG_MIN_DEPTH. BM_MIN_DEPTH /* added. */ /* 11-Dec-1990 SNS/CIT winname and iconname added to wininfo structure. */ /* BM_MIN_WIDTH, BM_MIN_HEIGHT, BM_WIDTH, BM_HEIGHT, */ /* BM_MAX_WIDTH, BM_MAX_HEIGHT, and BM_COLORS added. */ /* pix member of wininfo structure now a pointer. */ /* 12-Dec-1990 SNS/CIT LG_BDWIDTH changed to BORDER_WIDTH. BLANK_WIDTH /* added. Image, line, maxh, minh, maxw, and minw */ /* members added to wininfo structure. */ /* 17-Dec-1990 SNS/CIT colors member added to wininfo structure. */ /* 18-Dec-1990 SNS/CIT cursx and cursy members added to wininfo structure. */ /* 13-Mar-1991 SNS/CIT yoff member removed from wininfo structure. */ /* 29-Mar-1991 SNS/CIT line member removed from wininfo structure. */ /* 10-May-1991 SNS/CIT FAIL changed to -1. */ /* 26-Jul-1991 SNS/CIT Added bw member to wininfo structure for B&W */ /* 30-Jul-1991 SNS/CIT Added BM_MIN_COLORS definition. Added allcells and */ /* usecells member to wininfo structure for fastdisp */ /* 31-Jul-1991 SNS/CIT Added im, imdat, xoff, yoff, imwidth, imheight, */ /* modlut, mlx, mly, slope, offset, and visual members */ /* to wininfo structure. Added BM_MAX_SH_COLS and */ /* BM_MIN_SH_COLS definitions. */ /* 1-Aug-1991 SNS/CIT Added showcur, curxsc, curxoff, curysc, curyoff, dsc, */ /* doff, zim, zimdat, and zfac members to wininfo */ /* structure. */ /* 2-Aug-1991 SNS/CIT Max window sized increased to 2048x2048. xoff & yoff */ /* member of wininfo are now relative to raw data. */ /* 20-Aug-1991 SNS/CIT font and icon members added to wininfo structure */ /* 22-Aug-1991 SNS/CIT LOC_WIDTH and LOC_HEIGHT added. */ /* 27-Aug-1991 SNS/CIT invert member added to wininfo structure */ /* 3-Sep-1991 SNS/CIT CM_WIDTH and CM_HEIGHT added. */ /* 4-Oct-1991 SNS/CIT resource structure added. */ /* 7-Oct-1991 SNS/CIT KeySym members of resource structure added. */ /* 9-Oct-1991 SNS/CIT Font member of wininfo structure removed */ /* 14-Oct-1991 SNS/CIT Allcells and usecells members of wininfo removed */ /* 17-Oct-1991 SNS/CIT Modified to deal with 8 and 16 bit images */ /* 22-Nov-1991 SNS/CIT Resource structure now includes a PS output file, a */ /* printer, the number of microseconds to sleep between */ /* client existance checks, whether or not we should */ /* force the location window pixels to be square, and */ /* the number of color cells to copy from the default /* color map to any private color map. */ /* 25-Nov-1991 SNS/CIT Now has separate zoom factors for X & Y and allows */ /* user specification of the behaviour of line plots. */ /* 27-Nov-1991 SNS/CIT Now has one more way of controlling line plots. */ /* 31-Jan-1992 SNS/CIT LEAVE_COLORS added and leavecolors added to the */ /* resource structure */ /* 18-Feb-1992 SNS/CIT LG_MIN_COLORS added and lgcolors added to the */ /* resource structure. */ /* 24-Feb-1992 SNS/CIT Ro member added to the wininfo structure. Visual */ /* type #defines added. */ /* 3-Mar-1992 SNS/CIT visclass member added to resource structure. */ /* 8-Apr-1992 SNS/CIT USLEEP_TIME changed to 10000 */ /* 9-Apr-1992 SNS/CIT No longer uses a minimum or maximum dimensions for */ /* the windows. */ /* 10-Apr-1992 SNS/CIT winxoff and winyoff members added to the wininfo */ /* structure. */ /* 7-May-1992 SNS/CIT lgcross added to resource structure. */ /* 24-Jun-1992 SNS/CIT Added space for histogram equalization key and size */ /* 25-Jun-1992 SNS/CIT plothist added to resource structues. */ /* 26-Jun-1992 SNS/CIT HALF_TICK added. */ /* 30-Sep-1992 SNS/CIT LUT wrap resources and RCS id string added. */ /* 14-Oct-1992 SNS/CIT RCS id string now only added if INC_HEADER_RCS */ /* #define'd. Space for MOUSEMODE and DOBOX keys added. */ /* Now protected from doubel #include'sion */ #ifndef INC_FIGDISP_H #define INC_FIGDISP_H #ifndef lint #ifdef INC_HEADER_RCS static char figdisp_h_rcsid[]="@(#)$Id: figdisp.h,v 1.12 1992/10/19 02:18:32 figaro Exp $"; #endif #endif /* The figdisp structure needs definitions from Xutil.h */ #include #include /* some return value definitions */ /* The basics: */ #define FAIL 1 /* used if a routine fails for some reason. */ #define SUCCEED 0 /* the opposite of FAIL. MUST be 0 because 0 is the */ /* only value which can be uniquely identified in a */ /* test case (all other return values are failures */ /* of some sort) */ /* some more advanced: */ #define ALREADY_RUNNING 2 /* Another copy of the display routine is */ /* already running */ #define MALLOC_ERR 3 /* An error allocating something */ #define BADCOM 4 /* Someone gave us a bad command */ #define INCCOM 5 /* The last command in a command buffer was */ /* incomplete */ /* some default values */ #define LG_WIDTH 512 /* default width of the line graphics window */ #define LG_HEIGHT 512 /* default height of the line graphics window */ #define LG_MIN_WIDTH 64 /* The minimum line graphics window width */ #define LG_MIN_HEIGHT 64 /* The minimum line graphics window height */ #ifdef VMS /* Our VMS Machines don't have as much memory */ #define LG_MAX_WIDTH 512 /* The maximum line graphics window width */ #define LG_MAX_HEIGHT 512 /* The maximum line graphics window height */ #else #define LG_MAX_WIDTH 2048 /* The maximum line graphics window width */ #define LG_MAX_HEIGHT 2048 /* The maximum line graphics window height */ #endif #define LG_COLORS 16 /* The number of colors for line graphics */ #define LG_MIN_COLORS 2 /* Minimum number of colors for line graphics */ #define LG_MIN_DEPTH 4 /* The minimum depth of the line graphics */ /* window. Right now should be equal to log */ /* base 2 of LG_COLORS */ #define BORDER_WIDTH 1 /* width of the window border */ #define BLANK_WIDTH 5 /* width of the blank area between drawing */ /* surface and window border */ #define BM_MIN_DEPTH 8 /* The minimum depth of bitmap window */ #define BM_WIDTH 512 /* default width of bitmap window */ #define BM_HEIGHT 512 /* default height of bitmap window */ #define BM_MIN_WIDTH 64 /* minimum width of bitmap window */ #define BM_MIN_HEIGHT 64 /* minimum height of bitmap window */ #define BM_MAX_WIDTH 2048 /* maximum width of bitmap window. */ #define BM_MAX_HEIGHT 2048 /* maximum height of bitmap window */ #define BM_COLORS 65536 /* number of colors for bitmaps */ #define BM_MIN_COLORS 170 /* minimum number of colors for bitmaps */ #define BM_MAX_SH_COLS 225 /* maximum number of colors to use when we're */ /* sharing a color table */ #define BM_MIN_SH_COLS 200 /* minimum number of colors to use when we're */ /* sharing a color table */ #define LOC_WIDTH 128 /* the default location window width */ #define LOC_HEIGHT 128 /* the default location window height */ #define CM_WIDTH 256 /* default width of the color map window */ #define CM_HEIGHT 32 /* default height of the color map window */ #define MIN_USLEEP_TIME 10000 /* The minimum number of microseconds to */ /* wait between existance checks */ #define USLEEP_TIME 10000 /* The default number of microseconds to wait */ /* between existance checks */ #define SAVE_COLORS 6 /* The default number of colors to copy from */ /* the default colormap to any private */ /* color map we use. */ #define LEAVE_COLORS 0 /* The default number of colors to leave */ /* available in the default color map */ #define HIST_WIDTH 0 /* The default width of the histogram area */ /* 0 = use entire image */ #define HIST_HEIGHT 0 /* The default height of the histogram area */ #define HALF_TICK 2 /* Half the size of axis tick, in X11 pixels */ #define INIT_LUT_WRAP 1 /* The default initial LUT wrap factor */ /* some misc. constants */ #define MAXSTRLEN 80 /* The maximum string length */ #define UseDefaultCmap 1 /* Use the default color map */ #define UseRWVisual 2 /* Use a read/write visual */ #define UseROVisual 3 /* Use a read only visual */ /* These are two phony visual classes. The assume that the normal X visuals */ /* do not clash. For Openwindows 2.0, visuals classes are non-negative, so */ /* this is a valid assumption. */ #define AnyVis -1 /* Use any visual */ #define DefaultVis -2 /* Use only the default visual */ /* The number of characters in the box window */ #define BOX_COL_CHARS 16 /* The window information structure */ struct wininfo { Window win; /* The window for display */ unsigned long *pix; /* The pixel values */ Pixmap pixmap; /* The pixmap */ int mapped; /* True if window is mapped */ unsigned int height; /* current window height */ unsigned int width; /* current window width */ XTextProperty winname; /* The window's name */ XTextProperty iconname; /* The icon's name */ XImage *image; /* An image for the window's data */ unsigned char *imdat; /* The window's data */ int winxoff; /* The offset from the start of the window to the */ int winyoff; /* start of the Ximage structure */ int colors; /* the number of colors used by this window */ int cursx; /* The X position of the cursor */ int cursy; /* the Y position of the cursor */ int bw; /* If the display is black & white */ int ro; /* If the display is read only */ int xoff,yoff; /* offset from image data OF APPROPRIATE ZOOM FACTOR */ /* into Ximage */ int imwidth,imheight; /* width & height of the image */ int modlut; /* true is we're modifying the LUTs */ int mlx,mly; /* the place where we started modifying the luts */ double slope; /* slope of the LUT transfer function */ double offset; /* offset of the LUT transfer function */ int showcur; /* show cursor position */ float curxsc; /* cursor x scale value */ float curxoff; /* cursor x offset value */ float curysc; /* cursor y scale value */ float curyoff; /* cursor y offset value */ float dsc; /* data scale value */ float doff; /* data offset value */ int xzoom; /* X zoom factor */ int yzoom; /* Y zoom factor */ Pixmap icon; /* this window's icon */ int invert; /* true if we want to invert the color maps */ }; /* the geometry structure */ struct geometry { int w; /* the width */ int h; /* the height */ int x; /* the x position */ int y; /* the y position */ }; /* The rawdata union */ union rawdata { unsigned short *b16; /* for 16 bit data */ unsigned char *b8; /* for 8 bit data */ }; /* The keysym array definitions */ #define ZOOMIN 0 #define ZOOMNORM 1 #define ZOOMOUT 2 #define HELP 3 #define CURSOR 4 #define RECENTER 5 #define SHOWLOC 6 #define QUIT 7 #define SHOWCM 8 #define SHOWPAT 9 #define ROW 10 #define IMPS 11 #define WINPS 12 #define INVERT 13 #define SEEING 14 #define COL 15 #define DECSLIT 16 #define INCSLIT 17 #define RESSLIT 18 #define INHIBIT 19 #define ZOOMXIN 20 #define ZOOMXOUT 21 #define ZOOMYIN 22 #define ZOOMYOUT 23 #define HISTOGRAM 24 #define DECLUTWRAP 25 #define INCLUTWRAP 26 #define RESLUTWRAP 27 #define MOUSEMODE 28 #define DOBOX 29 #define NKEYS 30 /* the total number of defined keys */ /* the various resources which affect the display server operation */ struct resource { struct geometry bmgeo; /* the bitmap geometry */ struct geometry lggeo; /* the line graphics geometry */ struct geometry pgeo; /* the patch geometry */ struct geometry cgeo; /* the color map geometry */ struct geometry lgeo; /* the location geometry */ struct geometry histgeo; /* geometry of histogram area */ int maxcolors; /* number of shared colors to use */ int mincolors; /* minimum shared colors to use */ int maxpcolors; /* maximum number of private colors to use */ int minpcolors; /* minimum number of private colors to use */ int showhelp; /* true if we should show help */ KeySym keys[NKEYS]; /* the keys we use */ XFontStruct *textfont; /* The font to use for labels inside windows */ char *psfile; /* The PostScript output file */ char *printer; /* The printer to use */ int sleeptime; /* The number of microseconds to sleep between */ /* existance checks. See waitevent.c for details. */ int forcesquare; /* true if we should force location window */ /* pixels to be square */ int savecolors; /* The number of colors to copy from the default */ /* colormap to a private color map. */ int leavecolors; /* The number of colors to leave available */ /* in the default colormap. */ int lefttoright; /* true if the user always wants a line plot */ /* to go from left to right, even if he moved */ /* the mouse from right to left */ int ascendcoord; /* True if arbitrary line plots should follow */ /* ascending coordinates (which one determined by the */ /* slope of the line) */ int bottotop; /* True if column plots should go from bottom to top */ int ascendy; /* True if column plots should follow ascending Y */ /* values. If true, takes precedence over bottotop. */ int rowltor; /* True if row plots should go from left to right */ int ascendx; /* True if row plots should follow ascending X. If */ /* true, takes precedence over rowltor. */ int id; /* The figdisp id. Used to allow multiple figdisps */ /* on the same screen. */ int lgcolors; /* The number of colors for the line graphics screen */ int visclass; /* The visual class allowed */ int lgcross; /* True if we should use the crosshair cursor for the */ /* line graphics window. */ int plothist; /* True if line plots should be in histogram form */ int initwrap; /* The initial LUT wrap factor */ }; #endif /* INC_FIGDISP_H */ ions for */ /* the windows. */ /* 10-Apr-1992 SNS/CIT winxoff and winyoff members added to the wininfo */ /* structure. */ /* 7-May-1992 SNS/CIT lgcross added to resource structure. */ /* 24-Jun-1992 SNS/CIT Added space for histogram equalization key and size */ /* 25-Jun-1992 SNS/CIT plothist added to resource structues. */ /* 26-Jun-1992 SNS/CIT HALF_TICK added. */ /* 30-Sep-1992 SNS/CIT LUT wrap resources and RCS id string added. */ /* 14-Oct-1992 SNS/CIT RCpgplot/pgdispd/figdisp.icon010064400040640000322000000040660562620731200164740ustar00tjpcitmbr00000400000017#define figdisp_width 48 #define figdisp_height 55 static unsigned char figdisp_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0x00, 0x00, 0x10, 0x08, 0x10, 0x08, 0x00, 0x00, 0x10, 0x08, 0x10, 0x08, 0x00, 0x00, 0x08, 0x10, 0x08, 0x10, 0x00, 0x00, 0x08, 0x10, 0x08, 0x10, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x04, 0xe0, 0x07, 0xe0, 0x07, 0x20, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07, 0x10, 0x08, 0xf0, 0x0f, 0x10, 0x08, 0x10, 0x08, 0xf0, 0x0f, 0x10, 0x08, 0x08, 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x08, 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x04, 0xe0, 0xff, 0xff, 0x07, 0x20, 0x08, 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x08, 0x10, 0xf8, 0x1f, 0x08, 0x10, 0x10, 0x08, 0xf0, 0x0f, 0x10, 0x08, 0x10, 0x08, 0xf0, 0x0f, 0x10, 0x08, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x04, 0xe0, 0x07, 0xe0, 0x07, 0x20, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0x10, 0x08, 0xe0, 0x07, 0xe0, 0x07, 0xe0, 0x07, 0x00, 0x08, 0x10, 0x08, 0x10, 0x00, 0x00, 0x08, 0x10, 0x08, 0x10, 0x00, 0x00, 0x10, 0x08, 0x10, 0x08, 0x00, 0x00, 0x10, 0x08, 0x10, 0x08, 0x00, 0x00, 0xe0, 0x07, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 }; pgplot/pgdispd/getcolors.c010064400040640000322000000126250537332240500163420ustar00tjpcitmbr00000400000017/* The getcolors routine allocates between mincolors and maxcolors colors in */ /* the specified kind of visual (default color map, read/write visual, or */ /* read only visual). Visual is set to the visual used, cmap is set to the */ /* color map used, and pix is set to the pixels allocated. If the attempt to */ /* allocate colors is unsuccessful the values of these variables are */ /* undefined and may have been changed. If we are told to use a read only */ /* visual, no color map entries are actually allocated. */ /* Return Values: */ /* 0 We were unable to allocate the required number of colors */ /* other The number of colors we allocated. */ /* Sam Southard, Jr. */ /* Created: 20-Feb-1992 */ /* Modification History: */ /* 24-Feb-1992 SNS/CIT Now returns the visual depth as well */ /* 3-Mar-1992 SNS/CIT Now looks at TrueColor and Direct Color visuals as */ /* well. Now examines the user's visual specs. */ /* 6-Mar-1992 SNS/CIT Now takes max and min depth parameters */ /* 14-Apr-1992 SNS/CIT Now uses a quickie version of log2 */ #include "figdisp.h" #include "globals.h" /* The visual classes to use for r/w color maps, in order of preference */ static int rwvis[]={DirectColor, PseudoColor, GrayScale}; static int nrwvis=sizeof(rwvis)/sizeof(rwvis[0]); /* The visual classes to use for read only color maps, in order of preference */ static int rovis[]={TrueColor, StaticColor, StaticGray}; static int nrovis=sizeof(rovis)/sizeof(rovis[0]); int getcolors(vistype, visual, cmap, pix, maxcolors, mincolors, depth, maxdepth, mindepth) int vistype; /* The type of visual to use */ Visual **visual; /* The visual actually used */ Colormap *cmap; /* The color map actually used */ unsigned long *pix; /* The pixels allocated */ int maxcolors; /* The maximum number of colors to allocate */ int mincolors; /* The minimum number of colors to allocate */ int *depth; /* The depth of the visual actually used */ int maxdepth; /* The maximum allowed visual depth */ int mindepth; /* The minimum allowed visual depth */ { XVisualInfo vinfo; /* The template for our visual */ unsigned long pmtmp[1]; /* temporary for plane masks */ int i,j; /* silly loop variables */ int nvis; /* The number of visual classes to deal with */ int class; /* The visual class to use */ int colors; int defro; /* if the default visual is read-only */ /* first free up the color map. If it's not been set yet, we do no */ /* harm. */ if (*cmap != DefaultColormap(display, screen)) { XFreeColormap(display, *cmap); *cmap = DefaultColormap(display, screen); } if (vistype == UseDefaultCmap) { /* This is the easy case */ *visual=DefaultVisual(display, screen); /* make sure the user allows this kind of visual */ if (res.visclass >= 0 && res.visclass != (*visual)->class) return(0); *cmap=DefaultColormap(display, screen); *depth=DefaultDepth(display, screen); /* see if the default visual is read-only */ if ((*visual)->class == StaticGray || (*visual)->class == StaticColor || (*visual)->class == TrueColor) defro=1; else defro=0; /* Make sure we don't try too hard */ if (maxcolors > (*visual)->map_entries) maxcolors=(*visual)->map_entries; /* we may have a read-only default color map */ if (defro && maxcolors >= mincolors) return(maxcolors); while (maxcolors >= mincolors) { if (XAllocColorCells(display, *cmap, True, &pmtmp[0], 0, pix, (unsigned)maxcolors)) break; --maxcolors; } if (maxcolors >= mincolors) return(maxcolors); else return(0); } /* For these cases we have to go looking for a visual */ if (vistype == UseRWVisual) nvis=nrwvis; else nvis=nrovis; /* This is just a very specialized log2() */ for (i=31 ; i >= 0 ; --i) if (mincolors & (1< mindepth) mindepth=i; for (i=0 ; i < nvis ; ++i) { if (vistype == UseRWVisual) class=rwvis[i]; else class=rovis[i]; /* Make sure the user allows this kind of visual */ *visual=DefaultVisual(display, screen); if (res.visclass >= 0 && res.visclass != class || res.visclass == DefaultVis && class != (*visual)->class) continue; *depth=maxdepth; /* find a visual deep enough with enough available colors */ while (*depth >= mindepth) { if (XMatchVisualInfo(display, screen, *depth, class, &vinfo)) { /* we got a visual - can we allocate enough colors? */ *visual=vinfo.visual; *cmap=XCreateColormap(display, RootWindow(display, screen), *visual, AllocNone); if (vistype == UseROVisual) { if (maxcolors > (*visual)->map_entries) maxcolors= (*visual)->map_entries; if (maxcolors < mincolors) { /* this shouldn't happen... */ --(*depth); continue; } return(maxcolors); } /* go ahead and try to allocate the colors */ if (maxcolors > (*visual)->map_entries) colors= (*visual)->map_entries; else colors=maxcolors; while (colors >= mincolors) { if (XAllocColorCells(display, *cmap, True, &pmtmp[0], 0, pix, (unsigned)colors)) break; --colors; } /* Did we make it? */ if (colors >= mincolors) return(colors); /* well, on to the next visual */ if (*cmap != DefaultColormap(display, screen)) { XFreeColormap(display, *cmap); *cmap = DefaultColormap(display, screen); } } --(*depth); } /* we weren't successful, so on to the next visual class */ } /* Oh well...we gave it our best shot */ return(0); } pgplot/pgdispd/getvisuals.c010064400040640000322000000264050537332240600165310ustar00tjpcitmbr00000400000017/* The getvisuals routine gets a visual or visuals for the bitmap and line */ /* graphics windows. The following visuals are tried: */ /* (1) The default visual & color map for both of them. */ /* (2) Any visual which could have both of them in the same color map */ /* (3) (figdisp only) Bitmap in the default color map, line in anything */ /* (4) (figdisp only) Line in the default color map, bitmap in anything */ /* (5) (figdisp only) Bitmap and line in separate, non default anything */ /* (6) Reduce lg.colors to 16 (if possible) and repeat */ /* (7) Get a visual for bitmap graphics (steps 1-5) */ /* (8) Try to get a read-only visual & color map for line graphics with the */ /* original number of colors */ /* (9) Reduce lg.colors to 16 (if possible) and repeat step 8. */ /* (10) Reduce lg.colors to 2 and use BlackPixel and WhitePixel in default */ /* Return Values: */ /* FAIL If we couldn't get any appropriate visual combination. */ /* SUCCEED If everything went fine. */ /* Sam Southard, Jr. */ /* Created: 20-Feb-1992 (complete re-write of getbmvisual routine) */ /* Modification History: */ /* 25-Feb-1992 SNS/CIT Now initializes bit & line graphics color maps to the */ /* default. */ /* 5-Mar-1992 SNS/CIT Now handles grayscale and read-only visuals better */ /* 6-Mar-1992 SNS/CIT getcolors now takes a min and max visual depth. */ /* 9-Mar-1992 SNS/CIT Silly bug in two color mode fixed */ #include "figdisp.h" #include "globals.h" #include "messages.h" #include #define MAX_DEPTH 24 /* the maximum visual depth to use */ int getvisuals() { int i; /* Silly loop variable */ int linecolors; /* max number of line colors */ XColor color; /* a color table entry */ Visual *defvis; /* The default visual */ int defro; /* if the default visual is read-only */ linecolors=lg.colors=res.lgcolors; /* let's be optimistic */ bm.bw=lg.bw=lg.ro=0; /* more optimism */ bitvisual=linevisual=NULL; bitcmap=linecmap=DefaultColormap(display,screen); defvis=DefaultVisual(display, screen); /* see if the default visual is read-only */ if (defvis->class == StaticGray || defvis->class == StaticColor || defvis->class == TrueColor) defro=1; else defro=0; #ifdef PGDISP /* we don't have any bitmap colors in pgdisp */ res.maxcolors=res.maxpcolors=res.mincolors=res.minpcolors=0; #endif /* we have our standards */ if (lg.colors < 2) lg.colors=res.lgcolors=linecolors=2; /* Go ahead and allocate room for the number of colors we may need. */ /* Don't worry about waste, since it won't be very large */ i= lg.colors; if (res.savecolors > res.leavecolors) i += res.savecolors; else i += res.leavecolors; if ((lg.pix=(unsigned long *)malloc(i*sizeof(unsigned long))) == NULL) { (void)fprintf(stderr,MSG_MALLOC); return(FAIL); } if (res.maxpcolors < res.maxcolors) i=res.maxcolors; else i=res.maxpcolors; i += lg.colors; if (res.savecolors > res.leavecolors) i += res.savecolors; else i += res.leavecolors; if ((bm.pix=(unsigned long *)malloc(i*sizeof(unsigned long))) == NULL) { (void)fprintf(stderr,MSG_MALLOC); free(lg.pix); return(FAIL); } /* As long as we're not doing Black & White */ while (lg.colors > 2) { /* First step is to simply try the default color map, if it's */ /* not read-only, and then any visual which could handle them */ /* both. Bitmap graphics requires an 8-bit visual. */ if ((!defro && (bm.colors=getcolors(UseDefaultCmap, &bitvisual, &bitcmap, bm.pix, res.maxcolors+res.leavecolors+lg.colors, res.mincolors+res.leavecolors+lg.colors, &bitdepth, 8, 8))) || (bm.colors=getcolors(UseRWVisual, &bitvisual, &bitcmap, bm.pix, res.maxpcolors+res.savecolors+lg.colors, res.minpcolors+res.savecolors+lg.colors, &bitdepth, 8, 8))) { /* success! */ bm.colors -= lg.colors; /* we allocated both */ /* Free up the res.leavecolors extra we got */ if (res.leavecolors > 0 && bitcmap == DefaultColormap(display,screen)) { XFreeColors(display, bitcmap, bm.pix+bm.colors+lg.colors, res.leavecolors, 0); bm.colors -= res.leavecolors; } /* copy some from the default color map */ if (bitcmap != DefaultColormap(display,screen)) { for (i=0 ; i < res.savecolors ; ++i) { if (bitvisual->class == DirectColor) break; color.pixel=bm.pix[i]; if (bm.pix[i] >= defvis->map_entries) continue; XQueryColor(display, DefaultColormap(display,screen), &color); color.flags = DoRed | DoGreen | DoBlue; XStoreColor(display, bitcmap, &color); } /* update the pixel table to forget. Don't */ /* just change the pointer because we'll get */ /* in trouble when we do a free */ for (i=0 ; i 0) XFreeColors(display, bitcmap, bm.pix+bm.colors, res.leavecolors, 0); bm.colors -= res.leavecolors; } else { /* copy */ for (i=0 ; i < res.savecolors ; ++i) { if (bitvisual->class == DirectColor) break; color.pixel=bm.pix[i]; if (bm.pix[i] >= defvis->map_entries) continue; XQueryColor(display, DefaultColormap(display,screen), &color); color.flags= DoRed | DoGreen | DoBlue; XStoreColor(display, bitcmap, &color); } bm.colors -= res.savecolors; /* forget about the first few pixels */ for (i=0 ; i < bm.colors ; ++i) bm.pix[i]=bm.pix[i+res.savecolors]; } (void)printf("Got %d bitmap colors in ", bm.colors); if (bitcmap == DefaultColormap(display, screen)) (void)printf("default color map\n"); else (void)printf("private color map\n"); if (linecmap == DefaultColormap(display, screen)) { if (res.leavecolors > 0) XFreeColors(display, linecmap, lg.pix+lg.colors, res.leavecolors, 0); lg.colors -= res.leavecolors; } else { /* copy */ for (i=0 ; i < res.savecolors ; ++i) { if (linevisual->class == DirectColor) break; color.pixel=lg.pix[i]; if (lg.pix[i] >= defvis->map_entries) continue; XQueryColor(display, DefaultColormap(display,screen), &color); color.flags= DoRed | DoGreen | DoBlue; XStoreColor(display, linecmap, &color); } lg.colors -= res.savecolors; /* forget about the first few pixels */ for (i=0 ; i < lg.colors ; ++i) lg.pix[i]=lg.pix[i+res.savecolors]; } (void)printf("Got %d line graphics colors in ", lg.colors); if (linecmap == DefaultColormap(display, screen)) (void)printf("default color map\n"); else (void)printf("private color map\n"); break; /* don't try other schemes */ } #endif /* FIGDISP */ /* we did all we can with this many colors, so try with only */ /* 16 colors */ if (res.lgcolors > 16) res.lgcolors=lg.colors=16; else res.lgcolors=lg.colors=2; } if (linevisual != NULL && linevisual->class == GrayScale) lg.bw=1; if (bitvisual != NULL && bitvisual->class == GrayScale) bm.bw=1; /* did we make it out alive? */ if (lg.colors > 2) return(SUCCEED); #ifndef PGDISP /* we need a read-write for bitmap graphics */ if ((bm.colors=getcolors(UseDefaultCmap, &bitvisual, &bitcmap, bm.pix, res.maxcolors+res.leavecolors, res.mincolors+res.leavecolors, &bitdepth)) || (bm.colors=getcolors(UseRWVisual, &bitvisual, &bitcmap, bm.pix, res.maxcolors+res.savecolors, res.mincolors+res.savecolors, &bitdepth))) { /* success! */ if (bitcmap == DefaultColormap(display, screen)) { if (res.leavecolors > 0) XFreeColors(display, bitcmap, bm.pix+bm.colors, res.leavecolors, 0); bm.colors -= res.leavecolors; } else { /* copy */ for (i=0 ; i < res.savecolors ; ++i) { if (bitvisual->class == DirectColor) break; color.pixel=bm.pix[i]; if (bm.pix[i] >= defvis->map_entries) continue; XQueryColor(display, DefaultColormap(display,screen), &color); color.flags= DoRed | DoGreen | DoBlue; XStoreColor(display, bitcmap, &color); } bm.colors -= res.savecolors; /* forget about the first few pixels */ for (i=0 ; i < bm.colors ; ++i) bm.pix[i]=bm.pix[i+res.savecolors]; } (void)printf("Got %d bitmap colors in ", bm.colors); if (bitcmap == DefaultColormap(display, screen)) (void)printf("default color map\n"); else (void)printf("private color map\n"); } else { /* we're not gonna make it - we need LUT manipulation */ (void)fprintf(stderr, MSG_NOCOLORS); return(FAIL); } #endif /* Let's try a read-only for line graphics */ res.lgcolors=linecolors; lg.ro=1; while (res.lgcolors > 2) { if (lg.colors=getcolors(UseROVisual, &linevisual, &linecmap, lg.pix, res.lgcolors, res.lgcolors, &linedepth)) break; /* lower our standards */ if (res.lgcolors > 16) res.lgcolors=16; else res.lgcolors=2; } if (res.lgcolors <= 2) { /* Sorry, all we can do is BlackPixel & WhitePixel */ lg.pix[0]=BlackPixel(display, screen); lg.pix[1]=WhitePixel(display, screen); linecmap=DefaultColormap(display, screen); linedepth=DefaultDepth(display, screen); linevisual=DefaultVisual(display, screen); lg.colors=2; } if (linevisual->class == StaticGray) lg.bw=1; if (bitvisual->class == GrayScale) bm.bw=1; (void)printf("Got %d read-only line graphics colors in ", lg.colors); if (linecmap == DefaultColormap(display, screen)) (void)printf("default color map\n"); else (void)printf("private color map\n"); return(SUCCEED); } /* 6-Mar-1992 SNS/CIT getcolors now takes a min and max visual depth. */ /* 9-Mar-1992 SNS/CIT Silly bug in two color mode fixed */ #include "figdisp.h" #include "globals.h" #include "messages.h" #include #define MAX_DEPTH 24 /* the mapgplot/pgdispd/globals.h010064400040640000322000000112750537332240700157730ustar00tjpcitmbr00000400000017/* This file contains all the global variable definitions. */ /* Sam Southard, Jr. */ /* Created: 8-Oct-1991 (from figdisp) */ /* Modification History: */ /* 9-Oct-1991 SNS/CIT textfont added. */ /* 10-Oct-1991 SNS/CIT allcells and usecells added. */ /* 14-Oct-1991 SNS/CIT textfont moved into resource structure */ /* 17-Oct-1991 SNS/CIT Modified to deal with 8 and 16 bit images */ /* 24-Jun-1992 SNS/CIT histpix, usehist, and goodhist added. */ /* 27-Sep-1992 SNS/CIT shmid and shmtype added. */ /* 28-Sep-1992 SNS/CIT RCS id string added. */ /* 30-Sep-1992 SNS/CIT Now containts LUT wrap definitions */ /* 14-Oct-1992 ARC/HI Support for box & autodisp added. */ /* 14-Oct-1992 SNS/CIT Now only includes RCS id string if INC_HEADER_RCS is */ /* #define'd. */ #ifndef INC_GLOBALS_H #define INC_GLOBALS_H #ifndef lint #ifdef INC_HEADER_RCS static char global_h_rcsid[]="@(#)$Id: globals.h,v 1.7 1993/03/04 05:55:13 figaro Exp $"; #endif #endif /* Wish list: */ /* Get rid of global variables. */ #ifdef DEFINE_GLOBALS Display *display; /* the main display */ int mousemode = 1; /* 0=> center, slit, color, 1=> ul box, slit, lr box */ int screen; /* the main screen */ struct wininfo lg; /* The line graphics window */ struct wininfo bm; /* The bitmap graphics window */ struct wininfo patch; /* The patch window */ struct wininfo loc; /* The location window */ struct wininfo seeing; /* The seeing window */ struct wininfo cwin; /* The color map window */ struct wininfo box; /* The box window */ Atom selatom; /* The atom for the selection */ Atom dataatom; /* The atom for data */ Atom incrtype; /* The incremental type atom */ Atom lock; /* Used to ensure only one application at a time */ Colormap bitcmap; /* Was bm.cmap */ Colormap linecmap; /* Was lg.cmap */ Visual *bitvisual; /* Was bm.visual */ Visual *linevisual; /* Was lg.visual */ unsigned int bitdepth; /* Was bm.depth */ unsigned int linedepth; /* Was lg.depth */ XColor allcells[BM_COLORS]; /* The colors we'd use if we were the only */ /* application around */ XColor *usecells; /* The colors we can play with */ XColor locline; /* Color to use when drawing lines in the location */ /* window. Was loc.allcells[0]. */ GC bitgc; /* The gc to use with bitmap graphics. Was bm.gc */ GC bitgcclear; /* gc to to clear bitmap graphics. Was bm.gcclear */ GC linegc; /* Was lg.gc */ GC linegcclear; /* Was lg.gclear */ GC xorgc; /* The gc to use to draw XOR lines */ GC xdashgc; /* The gc used to draw dashed XOR lines */ GC textgc; /* The gc to use to print text */ GC textgcclear; /* The gc to use to clear text */ struct resource res; /* The resources to use */ Window srcwin; /* The source of the data */ int selset=0; /* If the selection window has been set */ union rawdata rimdat; /* The image data */ int bppix; /* The numebr of bits per pixel */ int *histpix; /* The index into allcells to use for histogram */ /* equalization. There are bm.colors of these */ int usehist; /* True if we should use histogram equalization */ int goodhist; /* True if histpix is valid. */ int shmtype; /* The type of shared memory */ int shmid; /* The shared memory id */ int lutwrap; /* The LUT wrapping factor */ int useramp; /* Flag to recall toggle of autodisp vs. normal */ double autodisp_lower; /* lo bound for LUT computed by autodisp */ double autodisp_upper; /* hi bound for LUT computed by autodisp */ int ul_x = -1, ul_y = -1, lr_x = -1, lr_y = -1; /* box bounds - image coords */ int ramplo, ramphi; /* The low and high bounds for linear scaling */ int sendidle = 0; /* true if the client has requested a FIGDISP_IDLE */ #else extern Display *display; extern int mousemode; extern int screen; extern struct wininfo lg; extern struct wininfo bm; extern struct wininfo patch; extern struct wininfo loc; extern struct wininfo seeing; extern struct wininfo cwin; extern struct wininfo box; extern Atom selatom; extern Atom dataatom; extern Atom incrtype; extern Atom lock; extern Colormap bitcmap; extern Colormap linecmap; extern Visual *bitvisual; extern Visual *linevisual; extern unsigned int bitdepth; extern unsigned int linedepth; extern XColor allcells[BM_COLORS]; extern XColor *usecells; extern XColor locline; extern GC bitgc; extern GC bitgcclear; extern GC linegc; extern GC linegcclear; extern GC xorgc; extern GC xdashgc; extern GC textgc; extern GC textgcclear; extern struct resource res; extern Window srcwin; extern int selset; extern union rawdata rimdat; extern int bppix; extern int *histpix; extern int usehist; extern int goodhist; extern int shmtype; extern int shmid; extern int lutwrap; extern int useramp; extern double autodisp_lower; extern double autodisp_upper; extern int ul_x, ul_y, lr_x, lr_y; extern int ramplo, ramphi; extern int sendidle; #endif #endif pgplot/pgdispd/initlgluts.c010064400040640000322000000040570537332241000165330ustar00tjpcitmbr00000400000017/* The initluts routine initializes the LUTs for the line graphics window */ /* Sam Southard, Jr. */ /* Created: 13-Mar-1991 (from figdisp/initluts) */ /* Modification History: */ /* 15-Aug-1991 SNS/CIT No longer contains hooks for xvideo */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ /* 14-Feb-1992 SNS/CIT Now deals with grey scale and read only visuals */ /* The X Window include files */ #include /* The program include files */ #include "figdisp.h" #include "globals.h" static unsigned short pgcolors[LG_COLORS][3]= { 0, 0, 0, 65535, 65535, 65535, 65535, 0, 0, 0, 65535, 0, 0, 0, 65535, 0, 65535, 65535, 65535, 0, 65535, 65535, 65535, 0, 65535, 32768, 0, 32768, 65535, 0, 0, 65535, 32768, 0, 32768, 65535, 32768, 0, 65535, 65535, 0, 32768, 21845, 21845, 21845, 43690, 43690, 43690 }; void initlgluts() { XColor color; /* The color table entry */ int i; /* silly loop variables */ /* If we're dealing with 2 colors, return right away, since it's */ /* already done. */ if (lg.colors == 2) return; color.flags=DoRed | DoGreen | DoBlue; /* PGPLOT defines the first 16 colors */ for (i=0 ; i < lg.colors && i < 16 ; ++i) { if (lg.bw) color.red=color.green=color.blue= 0.30*pgcolors[i][0]+0.59*pgcolors[i][1]+ 0.11*pgcolors[i][2]; else { color.red=pgcolors[i][0]; color.green=pgcolors[i][1]; color.blue=pgcolors[i][2]; } color.pixel=lg.pix[i]; if (lg.ro) { XAllocColor(display, linecmap, &color); lg.pix[i]=color.pixel; } else XStoreColor(display, linecmap, &color); } /* PGPLOT doesn't define these, but I will. It's a linear greyscale */ /* with black at 15 (although 15 is used by another color, since we */ /* already have a BlackPixel) and white at lg.colors-1. */ for ( ; i < lg.colors ; ++i) { color.red=color.green=color.blue= ((double)(i-15)/(lg.colors-16))*65535; color.pixel=lg.pix[i]; if (lg.ro) XAllocColor(display, linecmap, &color); else XStoreColor(display, linecmap, &color); } return; } pgplot/pgdispd/initlock.c010064400040640000322000000050110547646021600161530ustar00tjpcitmbr00000400000017/* The initlock routine initializes the locking mechanism and all atoms */ /* needed for Figaro/PGPLOT applications to communicate with the display */ /* server. */ /* Return Values: */ /* ALREADY_RUNNING A copy of the display server is already running on */ /* the requested screen. */ /* FAIL The initialization failed for some reason. */ /* SUCCEED Everything went fine. */ /* Sam Southard, Jr. */ /* Created: 01-Nov-1990 */ /* Modification History: */ /* 10-May-1991 SNS/CIT Modified for use in the Lick Xvideo program */ /* 15-Aug-1991 SNS/CIT No longer includes hooks for Xvideo */ /* 6-Sep-1991 SNS/CIT Changes from SSL::TENNANT included */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ /* 14-Feb-1992 SNS/CIT Now uses the id resource to allow multiple figdisps */ /* 14-Apr-1992 SNS/CIT Now compiles under VMS. */ /* The system include files */ #include /* The X windows include files */ #include /* The program include files */ #include "commands.h" #include "figdisp.h" #include "globals.h" #include "messages.h" int initlock() { char lockatomstr[MAXSTRLEN]; /* the name of the locking atom */ /* here we check to make sure that no other copy of this */ /* program is running on the selected display. */ (void)sprintf(&lockatomstr[0],"%s_%d_%d",NAME_PROG,screen,res.id); if ((lock=XInternAtom(display,&lockatomstr[0],False)) == None) { (void)fprintf(stderr,MSG_BADLOCKATOM); return(FAIL); } /* if the atom is owned by someone other than this program */ /* than another copy of this program is running and we */ /* should go away */ if (XGetSelectionOwner(display,lock) != None) { /* if the atom is owned, another display process is running */ (void)fprintf(stderr,MSG_ALREADYRUNNING); return(ALREADY_RUNNING); } /* now we set up the atom for incremental transfers */ (void)sprintf(&lockatomstr[0],"%s_%d_%d",NAME_INCRATOM,screen,res.id); if ((incrtype=XInternAtom(display,&lockatomstr[0],False)) == None) { (void)fprintf(stderr,MSG_BADINCRATOM); return(FAIL); } /* now we set up the atom for data */ (void)sprintf(&lockatomstr[0],"%s_%d_%d",NAME_DATAATOM,screen,res.id); if ((dataatom=XInternAtom(display,&lockatomstr[0],False)) == None) { (void)fprintf(stderr,MSG_BADDATAATOM); return(FAIL); } /* now we set up the atom to use for selections */ (void)sprintf(&lockatomstr[0],"%s_%d_%d",NAME_SELATOM,screen,res.id); if ((selatom=XInternAtom(display,&lockatomstr[0],False)) == None) { (void)fprintf(stderr,MSG_BADSELATOM); return(FAIL); } return(SUCCEED); } pgplot/pgdispd/initwmattr.c010064400040640000322000000035110547646024400165450ustar00tjpcitmbr00000400000017/* The initwmattr routine notifies the window manager of the approprate */ /* attributes for the given window. */ /* Sam Southard, Jr. */ /* Created: 9-Oct-1991 (from initbmwin) */ /* Modification History: */ /* 14-Apr-1992 SNS/CIT Now compiles under VMS */ /* The program include files */ #include "commands.h" #include "figdisp.h" #include "globals.h" /* The system include files */ #include void initwmattr(wininf,wname,iname,geom) struct wininfo wininf; /* the information about this window */ char *wname; /* The name for the window */ char *iname; /* the name for the icon */ struct geometry *geom; /* The windows geometry. May be NULL */ { char winnamebuf[80]; /* a buffer for the window name */ char *strptr= &winnamebuf[0]; /* pointer to buffer */ XSizeHints sizehints; /* the size & position */ XWMHints wm_hints; /* hints to the window manager */ /* set up the geometry if necessary */ if (geom != NULL) { sizehints.x=geom->x; sizehints.y=geom->y; sizehints.width=geom->w; sizehints.height=geom->h; sizehints.flags=USSize; if (sizehints.x >= 0 && sizehints.y >= 0) sizehints.flags |= USPosition; XSetWMNormalHints(display, wininf.win, &sizehints); } #ifndef _AIX /* set up the window and icon names */ (void)sprintf(&winnamebuf[0], "%s/%s", NAME_PROG, wname); if (XStringListToTextProperty(&strptr, 1, &wininf.winname)) XSetWMName(display, wininf.win, &wininf.winname); (void)sprintf(&winnamebuf[0],"%s", iname); if (XStringListToTextProperty(&strptr, 1, &wininf.iconname)) XSetWMIconName(display, wininf.win, &wininf.iconname); #endif /* Set up the hints the window manager needs */ wm_hints.input = True; wm_hints.icon_pixmap=wininf.icon; wm_hints.initial_state=NormalState; wm_hints.flags = InputHint | IconPixmapHint | StateHint; XSetWMHints(display, wininf.win, &wm_hints); return; } pgplot/pgdispd/mainloop.c010064400040640000322000000062550537332241300161600ustar00tjpcitmbr00000400000017/* The mainloop routine contains the main event loop. */ /* Return Values: */ /* FAIL If something went wrong */ /* SUCCEED If the user requested an exit */ /* Sam Southard, Jr. */ /* Created: 2-Nov-1990 */ /* 15-Nov-1990 SNS/CIT Modified to get data as a short instead of a char. */ /* 16-Nov-1990 SNS/CIT Modified to handle variable sized windows and to */ /* grab ownership of the selection atom if the client */ /* program goes away. */ /* 19-Nov-1990 SNS/CIT Modified to be able to get the cursor value and to */ /* send information back to the client program. */ /* 10-Dec-1990 SNS/CIT Now puts line graphics window to top when waiting for */ /* a cursor point. Now uses wininfo structure. VMS */ /* changes merged in. Now creates a window 10 pixels */ /* larger than the requested size so that graphics are */ /* not right at the edge of the window. */ /* 11-Dec-1990 SNS/CIT No longer exits if it receives a bad data type. Does */ /* not warp the pointer if requested to put it at the */ /* last point. */ /* 12-Dec-1990 SNS/CIT Now handles a bitmap graphics window. Some of the */ /* code from the main case statement moved into separate */ /* routines. */ /* 13-Dec-1990 SNS/CIT Now calls writeimage to clean up if the connection to */ /* the user program goes away for any reason. */ /* 15-Dec-1990 SNS/CIT Data acquisition moved into getdata(). */ /* 18-Dec-1990 SNS/CIT Cursor location now in wininfo structure. */ /* 10-May-1991 SNS/CIT Modified so that we can share some routines with the */ /* Lick Xvideo program. */ /* 31-Jul-1991 SNS/CIT Modified to handle fastdisp as well. */ /* 2-Aug-1991 SNS/CIT Now puts the current value of the cursor as soon as */ /* cursor tracking is selected. */ /* 14-Aug-1991 SNS/CIT No longer contains hooks for xvideo */ /* 20-Aug-1991 SNS/CIT Now handles a patch window */ /* 22-Aug-1991 SNS/CIT Now handles a location window */ /* 27-Aug-1991 SNS/CIT Now handles LUT inversion and seeing */ /* 3-Sep-1991 SNS/CIT Now handles color map window */ /* 5-Sep-1991 SNS/CIT Modified to lint cleanly */ /* 17-Sep-1991 SNS/CIT Key presses now handled in the dokey routine. */ /* Updatetitle moved to its own file. */ /* 1-Oct-1991 SNS/CIT Slit (general row/column plot) feature added */ /* 4-Oct-1991 SNS/CIT Now indicates line for line plots with an XOR line */ /* 17-Oct-1991 SNS/CIT Modified to deal with 8 and 16 bit images */ /* 22-Nov-1991 SNS/CIT Now handles waitevent returning an error */ /* 29-Jan-1992 SNS/CIT Now uses the handlexevent routine to process X events */ /* 7-May-1992 SNS/CIT Unused #includes removed. */ /* The system include files */ #include /* The X Window include files */ #include #include #include /* The program include files */ #include "figdisp.h" #include "globals.h" int mainloop() { XEvent event; /* the current event */ int go_on=1; /* whether or not we should continue */ while (go_on) { /* if we think there's a client out there, we need to time */ /* out if the client dies */ if (selset) selset=waitevent(); if (selset == -1) return(FAIL); XNextEvent(display,&event); if (handlexevent(event,&go_on) == FAIL) return(FAIL); } return(SUCCEED); } pgplot/pgdispd/ntoh.c010064400040640000322000000007470537332241500153140ustar00tjpcitmbr00000400000017/* These routines convert fmmo network to host byte order and back. They */ /* should only be used on machines where the OS does not already define */ /* the relevant functions */ /* Sam Southard, Jr. */ /* Created: 22-Apr-1993 */ unsigned short ntohs (netshort) unsigned short netshort; { unsigned short retval; retval = (((netshort & 0xFF) << 8) | (netshort >> 8)); return (retval); } unsigned short htons (hostshort) unsigned short hostshort; { return (ntohs (hostshort)); } pgplot/pgdispd/messages.h010064400040640000322000000100360537332241400161470ustar00tjpcitmbr00000400000017/* This file contains the definitions of the error/status messages generated */ /* by the Figaro display server */ /* Sam Southard, Jr. */ /* Created: 1-Nov-1990 */ /* 2-Nov-1990 SNS/CIT MSG_NODATAOWN, MSG_BADGETPROP, and MSG_BADDATATYPE */ /* added. */ /* 7-Nov-1990 SNS/CIT MSG_BADSELOWN and MSG_NOVISUAL added. */ /* 8-Nov-1990 SNS/CIT MSG_BADDISPOPEN added. */ /* 20-Nov-1990 SNS/CIT MSG_REPLYNOTSENT added. */ /* 10-Dec-1990 SNS/CIT MSG_NOLOCK added. */ /* 11-Dec-1990 SNS/CIT MSG_NOBM_VISUAL added. MSG_NOCOLORS generalized. */ /* 3-Apr-1991 SNS/CIT MSG_OLD_LOST, MSG_CHOP_X, and MSG_CHOP_Y added. */ /* 20-Aug-1991 SNS/CIT MSG_LOADFONT added. */ /* 23-Aug-1991 SNS/CIT MSG_LWOPENERR added. */ /* 3-Mar-1992 SNS/CIT MSG_NOCOLORS updated to include visual possibility. */ /* 9-Mar-1992 SNS/CIT MSG_TRYRESIZE & MSG_BADRESIZE added. */ /* 24-Jun-1992 SNS/CIT MSG_SMALLHIST added. */ /* 26-Jun-1992 SNS/CIT MSG_LGWINTOOSMALL added. */ /* If the screen already contains a copy of this server */ #define MSG_ALREADYRUNNING "There is aready a display on your screen!\n" /* If we could not obtain a locking atom */ #define MSG_BADLOCKATOM "Could not create locking atom!\n" /* If we could not own the locking atom (locking will not work) */ #define MSG_NOLOCK "Could not own locking atom! Locking will not work!\n" /* If we could not obtain an atom for the incremental type */ #define MSG_BADINCRATOM "Could not create incremental type atom!\n" /* If we could not obtain a data atom */ #define MSG_BADDATAATOM "Could not create data atom!\n" /* If we could not obtain a selection atom */ #define MSG_BADSELATOM "Could not create selection atom!\n" /* If the display does not support the requested pixmap depth */ #define MSG_BADPIXMAPDEPTH "Your server does not support the required depth!\n" /* If the selection atom seems to have no owner */ #define MSG_NOSELOWN "The selection atom has no owner!\n" /* If there was an error getting data from a property */ #define MSG_BADGETPROP "Could not get the data from the data atom!\n" /* If we received a bad data type */ #define MSG_BADDATATYPE "Display server received an unsupported data type!\n" /* If we can't own the selection atom */ #define MSG_BADSELOWN "Could not get ownership of selection atom!\n" /* If we can't allocate colors in the color map */ #define MSG_NOCOLORS \ "Could not allocate colormap entries in the requested visual!\n" /* If we can't get memory */ #define MSG_MALLOC "Could not allocate memory!\n" /* If we can't open the display */ #define MSG_BADDISPOPEN "Could not open the standard display!\n" /* If we can't send a reply to the client (because he went away) */ #define MSG_REPLYNOTSENT "Could not return a reply!\n" /* If the X11 display server does not support a bitmap visual */ #define MSG_NOBMVISUAL \ "The X Display server does not support an appropriate visual!\n" /* If we must delete the old image before copying whatever fits to the new */ #define MSG_OLD_LOST \ "Memory requirements forced loss of image data." /* If we must chop the X dimension to fit into memory. */ #define MSG_CHOP_X \ "Memory requirements forced a smaller image width." /* If we must chop the Y dimension to fit into memory. */ #define MSG_CHOP_Y \ "Memory requirements forced a smaller image height." /* if an XLoadQueryFont fails */ #define MSG_FONTLOAD "Unable to load font!\n" /* if the open of the laser printer file fails */ #define MSG_LWOPENERR "Unable to open laser printer file!\n" /* if we are about to try to resize the window */ #define MSG_TRYRESIZE \ "Trying to resize the window. Some window managers just ignore a\n\ program's attempts to resize a window, so you may have to do it yourself\n" /* if a resize appears to fail */ #define MSG_BADRESIZE \ "Hmm...I detect that a resize request went unhonored. Things may be\n\ a little wierd unless you make this window smaller\n" /* If the area used to calculate the histogram is too small */ #define MSG_SMALLHIST \ "The area used to calculate the histogram is too small!\n" #define MSG_LGWINTOOSMALL \ "The line graphics window is too small for a plot\n" pgplot/pgdispd/nocursor.icon010064400040640000322000000001360537332241400167130ustar00tjpcitmbr00000400000017#define nocursor_width 1 #define nocursor_height 1 static char nocursor_bits[] = { 0x00 }; pgplot/pgdispd/pgdisp.c010064400040640000322000000055270537332241500156330ustar00tjpcitmbr00000400000017/* This routine is the main routine for the Figaro X Window display server. */ /* The initial features will include the initial line graphics capabilites */ /* as descried in the SPECS document. */ /* Sam Southard, Jr. */ /* Created: 25-Oct-1990 */ /* 2-Nov-1990 SNS/CIT mainloop now returns an integer */ /* 8-Nov-1990 SNS/CIT added cursor location globals */ /* 14-Nov-1990 SNS/CIT modified to use a pixmap */ /* 17-Nov-1990 SNS/CIT lgyoff, lgheight, and lgwidth global variables added */ /* 10-Dec-1990 SNS/CIT All line graphics variables put into a single struct. */ /* Wininfo struct for bitmapped graphics added. */ /* 9-May-1991 SNS/CIT All reference to imaging capabilities removed to */ /* produce a PGPLOT-only display server. Variable names */ /* changed to co-exist with Lick Xvideo routines. */ /* 15-Aug-1991 SNS/CIT No longer includes xvideo hooks. */ /* 6-Sep-1991 SNS/CIT Modified to lint cleanly */ /* 8-Oct-1991 SNS/CIT Global variables now in globals.h */ /* 14-Oct-1991 SNS/CIT Now handles resource specification */ /* 24-Feb-1992 SNS/CIT Now gets a visual */ /* 14-Oct-1992 SNS/CIT Now #defines INC_HEADER_RCS to include .h RCS id */ /* strings. Now includes all .h files so that all RCS */ /* id strings get into the executable. */ /* Wish list: */ /* Add a command line flag to ignore possible presence of a lock. */ /* Get rid of global variables. */ /* system include files */ #include /* X Window include files */ #include /* Program include files */ #define DEFINE_GLOBALS #define INC_HEADER_RCS #include "figdisp.h" #include "messages.h" #include "globals.h" #include "commands.h" #undef DEFINE_GLOBALS #undef INC_HEADER_RCS int main(argc,argv) int argc; char **argv; { Display *XOpenDisplay(); void cleanup(); /* clean up before exiting */ void parsedisp(); void mergeops(); void extractops(); /* Initialize stuff for the resource manager */ XrmInitialize(); /* parse the command line options */ parsedisp(&argc, argv); screen=DefaultScreen(display); /* get server defaults, program defaults, and .Xdefaults merged */ /* in with the command line */ mergeops(); /* extract the options into a program readable form */ extractops(); #ifdef DEBUG XSynchronize(display, True); #endif /* Set up the resource/locking mechanism and the Atoms needed to */ /* communicate with applications and initialize the window */ if (initlock() || getvisuals() || initlgwin()) return(FAIL); /* Map the window. This is not done in initlgwin because initlgwin */ /* is shared with the Vista server, and the vista server is busy */ /* enough as it is. */ XMapWindow(display,lg.win); lg.mapped=1; /* process events from the applications */ (void)mainloop(); /* clean up the windows */ cleanup(); /* note that we still need to clean up misc. things */ #ifdef VMS return (1); #else return(SUCCEED); #endif } location globals */ /* 14-Nov-1990 SNS/CIT modified to use a pixmap */ /* 17-Nov-1990 SNS/CIT lgyoff, lgheight, and lgwidth global variables added */ /* 10-Dec-1990 SNSpgplot/pgdispd/proccom.c010064400040640000322000000731560562620563700160210ustar00tjpcitmbr00000400000017/* The proccom routine processes the data from the program controlling the */ /* display server. Each message can contain more than one command. If a */ /* values of 0 is passed for len than this is assumed to be the last time */ /* this routine is to be called in this particular incrementat transfer. */ /* Return Values: */ /* SUCCEED If everything went fine */ /* BADCOM If an invalid command was found */ /* INCCOM If an incomplete command was sent. This error code is only */ /* returned if this is the last transfer in an incremental */ /* transfer. */ /* FAIL If an X Window command fails */ /* MALLOC_ERR If a malloc fails */ /* Sam Southard, Jr. */ /* Created: 6-Nov-1990 */ /* 15-Nov-1990 SNS/CIT Modified to support commands being split across two */ /* messages. New format for TOK_DRAW_LINE and */ /* TOK_DRAW_POLY (see commands.h) used. All arguments */ /* except for the pixel values for the bitmap write */ /* command are now shorts. */ /* 16-Nov-1990 SNS/CIT Code for TOK_SET_LG_SIZE, TOK_DRAW_DOT, */ /* TOK_FILL_POLY, and TOK_FILL_RECT added. */ /* 19-Nov-1990 SNS/CIT Code for TOK_LG_MAX_DIM, TOK_LG_SCALE, TOK_LG_CURS, */ /* and TOK_LG_DEF_SIZE added. */ /* 8-Dec-1990 SNS/CIT Now only does an XCopyArea once per call to proccom. */ /* 10-Dec-1990 SNS/CIT Now uses wininfo structure. VMS changes merged in. */ /* Now allows for 5 pixel border around graphics. */ /* 11-Dec-1990 SNS/CIT TOK_RESET no longer clears the screen. */ /* 12-Dec-1990 SNS/CIT Now handles bitmap graphics commands. */ /* 17-Dec-1990 SNS/CIT Now uses the writeluts routine to handle the new */ /* format for the TOK_SET_BM_LUT command. */ /* 2-Apr-1991 SNS/CIT Image capbilities #ifdef'ed out for inclusion in the */ /* Lick xvideo program. */ /* 3-Apr-1991 SNS/CIT Image capabilities modified for use in Lick program. */ /* 8-Apr-1991 SNS/CIT Modified to simply print an error message (instead of */ /* exiting) when a bad command is encountered. */ /* 18-Apr-1991 SNS/CIT Image LUT capabilities modified for Lick Xvideo. */ /* 20-Apr-1991 SNS/CIT Cursor capabilities modified for Lick Xvideo. */ /* 22-Apr-1991 SNS/CIT Now handles the TOK_SET_BM_CSCALE and */ /* TOK_BM_SET_DSCALE commands. */ /* 6-May-1991 SNS/CIT Added figim variable to help with color bar. */ /* 10-May-1991 SNS/CIT Modified to be shared between Xvideo and pgdisp */ /* 17-Jun-1991 SNS/CIT Now handles the TOK_BM_FLUSH command. */ /* TOK_SET_BM_DSCALE modified to get a float param. */ /* 31-Jul-1991 SNS/CIT Modified to be shared with fastdisp. */ /* 1-Aug-1991 SNS/CIT Modified to handle the TOK_BM_LINE command. */ /* 7-Aug-1991 SNS/CIT Now raises line graphics window when appropriate */ /* 14-Aug-1991 SNS/CIT No longer contains hooks for xvideo */ /* 23-Aug-1991 SNS/CIT Now updates the location window */ /* 5-Sep-1991 SNS/CIT Modified to lint as cleanly as possible */ /* 8-Oct-1991 SNS/CIT Globals moved into globals.h */ /* 14-Oct-1991 SNS/CIT Allcells no longer in bm structure */ /* 17-Oct-1991 SNS/CIT Modified to deal with 8 and 16 bit images */ /* 11-Feb-1992 SNS/CIT Fixed bug causing line graphics data to be lost when */ /* the user resized while a PGPLOT program was being run */ /* 14-Feb-1992 SNS/CIT Now clears the line graphics window to lg.pix[0] not */ /* BlackPixel */ /* 25-Feb-1992 SNS/CIT Now handles line graphics windows with > 16 colors */ /* 26-Feb-1992 SNS/CIT Now handles recieving bitmap graphics commands in */ /* pgdisp and ignores commands in a buffer after an */ /* unknown command has occurred. */ /* 5-Mar-1992 SNS/CIT Line graphics now works on read-only & grey-scale */ /* visuals. */ /* 9-Apr-1992 SNS/CIT No longer has minimum and maximum window sizes in the */ /* wininfo structure. */ /* 10-Apr-1992 SNS/CIT Now knows how to handle lg.winxoff & lg.winyoff */ /* 14-Apr-1992 SNS/CIT Now compiles under VMS */ /* 25-Jun-1992 SNS/CIT SET_BM_LUT now has number of bits per pixel */ /* 9-Jul-1992 SNS/CIT SET_LG_SIZE now takes the new size as claimed (it had */ /* been taking the maximum coordinate, which is one */ /* less) */ /* 22-Sep-1992 SNS/CIT BM_ZOOMPAN implemented. */ /* 23-Sep-1992 SNS/CIT SET_BM_DSCALE changed to use ASCII strings. */ /* 27-Sep-1992 SNS/CIT Now allows for the server running on a machine with */ /* a different byte order. SET_LG_CSCALE changed to use */ /* ASCII strings. SET_BM_SH_SIZE and BM_SH_UPDATE */ /* implemented. */ /* 28-Sep-1992 SNS/CIT rcsid string added. */ /* 14-Oct-1992 SNS/CIT Merged in changes from ARC/HI. */ /* 16-Oct-1992 SNS/CIT Now resets goodhist for shared memory updates. */ /* 4-Nov-1992 SNS/CIT AUTODISP command now takes ASCII-encoded strings. */ /* LG_PIXLINE now resets the drawing color properly. */ /* Extra arguments to XFillRectangle in SET_LG_SIZE */ /* removed. */ /* 22-Aug-1994 TJP/CIT Fix bug in positioning thick dots. */ #ifndef lint static char rcsid[]="@(#)$Id: proccom.c,v 1.17 1993/10/08 00:02:48 figaro Exp figaro $"; #endif /* The system include files */ #include #include #include #ifndef VMS #include #endif #ifdef sun #include #endif /* The X Window include files */ #include #include #include #include /* The program include files */ #include "commands.h" #include "figdisp.h" #include "globals.h" #include "messages.h" /* A trivial macro */ #define min(x,y) (((x) > (y)) ? (y) : (x)) int proccom(buf,len,retbuf,retbuflen) unsigned short *buf; /* the buffer of commands and arguments */ int len; /* the length of the buffer */ unsigned short *retbuf; /* a buffer for return values */ int *retbuflen; /* the length of retbuf */ { static short bufcont[7]; /* the buffer contents while we're */ /* working on things */ static int buflen; /* the return buffer length */ static int lgcolor; /* the current color */ static unsigned int lglinewid; /* line graphics line width */ int i,j,k,l; /* silly loop variables */ int thislut; /* the current lut entry */ XColor color; /* a structure for changing LUTs */ XPoint *points; /* for drawing a poly line */ int minx,maxx,miny,maxy; /* minimum and maximum x and y for */ /* updating an effected area */ static int savedshorts=0; /* The number of saved shorts */ static short *olddata; /* the saved data */ int usedolddata=0; /* if we use data from a previous call */ unsigned short *bothbuf; /* buffer for sum of the two data parts */ /* dimensions for updating screen */ int cminx=lg.width,cmaxx=0,cminy=lg.height,cmaxy=0; Pixmap temppixmap; /* a pixmap used to transfer from old size to */ /* new size */ int npix; /* the number of pixels to write */ short *sptr; /* A pointer to a short */ char *tmpptr; /* A temporary pointer to a string. */ double dtmp1, dtmp2; #ifdef PGDISP int badbmcom=0; /* if a bitmap command is recieved in PGDISP */ int bppix,startx,starty,nline; /* vars to decode commands */ #else unsigned short *im16; /* used to access the image */ unsigned char *im8; /* used to access the 8-bit image */ /* note that this should be short even in FASTDISP */ short *tempim; /* a pointer to new image structure */ #endif void initlgluts(); /* initialize the LUTs */ void pgscurs(); /* set the line graphics cursor position */ void returnbuf(); /* return the answer to the client */ void bmscurs(); /* set the bitmap graphics cursor position */ void redrawim(); /* redraw the bitmap graphics window */ void drawline(); /* draw a line in the bitmap window */ Pixmap XCreatePixmap(); char *malloc(); if (!len & savedshorts) { /* an incomplete command was sent! */ savedshorts=0; free((char *)olddata); return(INCCOM); } if (savedshorts) { /* There's some data left over from the old command */ usedolddata=1; #ifdef lint bothbuf=NULL; if (!(malloc( #else if (!(bothbuf=(unsigned short *)malloc( #endif (unsigned)(savedshorts+len)*sizeof(unsigned short)))) { (void)fprintf(stderr,MSG_MALLOC); return(MALLOC_ERR); } /* first old data */ (void)memcpy((char *)bothbuf,(char *)olddata, savedshorts*sizeof(short)); /* then new data */ (void)memcpy((char *)(bothbuf+savedshorts),(char *)buf, len*sizeof(short)); len += savedshorts; buf=bothbuf; free((char *)olddata); savedshorts=0; } while (len-- > 0) { /* until there are no more commands to process */ switch(ntohs(*buf++)) { case RESET: /* reset the display server */ initlgluts(); lgcolor=1; lglinewid=0; XSetLineAttributes(display, linegc, lglinewid, LineSolid, CapRound, JoinRound); break; case SHOW_LG_WIN: /* conceal/reveal line graphics */ if (!len) { /* save this data for the next time around */ savedshorts=1; --buf; break; } if (ntohs(*buf++)) { XMapWindow(display,lg.win); lg.mapped=1; XRaiseWindow(display,lg.win); } else { XUnmapWindow(display,lg.win); lg.mapped=0; } --len; break; case SET_LG_LUT: /* set line graphics LUTs */ if (len < 2) { /* save the data */ savedshorts=len+1; --buf; break; } thislut= ntohs(*buf++); i= ntohs(*buf++); len -= 2; if (len < 3*i) { savedshorts=len+3; buf -= 3; break; } color.flags = DoRed | DoGreen | DoBlue; while (thislut < lg.colors && i > 0) { color.pixel=lg.pix[thislut]; color.red= ntohs(*buf++); color.green= ntohs(*buf++); color.blue= ntohs(*buf++); if (lg.bw) { color.red=0.30*color.red+ 0.59*color.green+ 0.11*color.blue; color.blue=color.green=color.red; } if (!lg.ro) XStoreColor(display, linecmap, &color); else { XAllocColor(display, linecmap, &color); lg.pix[thislut]=color.pixel; /* Did we change the foreground? */ if (thislut == lgcolor) XSetForeground(display, linegc, lg.pix[lgcolor]); /* did we change the background? */ if (thislut == 0) XSetBackground(display, linegc, 0); } len -= 3; ++thislut; --i; } /* eat up any extra LUT entries */ buf += i*3; len -= i*3; break; case LG_CURS: /* set and get cursor location */ if (len < 2) { savedshorts=len+1; --buf; break; } /* find out where the cursor is now */ bufcont[0]= htons(LG_CURS); bufcont[1]= *buf++; bufcont[2]= *buf++; buflen=4; /* position the cursor */ pgscurs(ntohs(bufcont[1]),ntohs(bufcont[2])); /* is an event already there? */ if (pggcurs(&bufcont[0])) { /* There's already an event there */ returnbuf(&bufcont[0],4,srcwin); buflen=0; } len -= 2; break; case SET_LG_COL: /* set the line graphics color index */ if (!len) { savedshorts=1; --buf; break; } lgcolor= ntohs(*buf++); if (lgcolor >= lg.colors) lgcolor=1; XSetForeground(display, linegc, lg.pix[lgcolor]); --len; break; case DRAW_LINE: /* draw a line */ if (len < 4) { savedshorts=len+1; --buf; break; } minx= ntohs(*buf++); miny= ntohs(*buf++); maxx= ntohs(*buf++); maxy= ntohs(*buf++); XDrawLine(display, lg.pixmap, linegc, minx, miny, maxx, maxy); if (minx > maxx) { /* swap for the XCopyArea */ i=minx; minx=maxx; maxx=i; } if (miny > maxy) { /* swap for the XCopyArea */ i=miny; miny=maxy; maxy=i; } if (--minx < cminx) cminx=minx; if (++maxx > cmaxx) cmaxx=maxx; if (--miny < cminy) cminy=miny; if (++maxy > cmaxy) cmaxy=maxy; len -= 4; break; case DRAW_POLY: /* draw a poly line */ if (!len) { savedshorts=1; --buf; break; } i= ntohs(*buf++); /* se if there's enough data */ if (--len < i*2) { savedshorts=len+2; buf -= 2; } #ifdef lint points=NULL; if (!malloc((unsigned)i*sizeof(XPoint))) #else if (!(points=(XPoint *)malloc( (unsigned)i*sizeof(XPoint)))) #endif { (void)fprintf(stderr,MSG_MALLOC); return(MALLOC_ERR); } j=0; minx=lg.width; maxx=0; miny=lg.height; maxy=0; while (i-- > 0) { if ((int)ntohs(*buf) < minx) minx= ntohs(*buf); if ((int)ntohs(*buf) > maxx) maxx= ntohs(*buf); points[j].x= ntohs(*buf++); if ((int)ntohs(*buf) < miny) miny= ntohs(*buf); if ((int)ntohs(*buf) > maxy) maxy= ntohs(*buf); points[j++].y= ntohs(*buf++); len -= 2; } XDrawLines(display, lg.pixmap, linegc, points, j, CoordModeOrigin); free((char *)points); if (--minx < cminx) cminx=minx; if (++maxx > cmaxx) cmaxx=maxx; if (--miny < cminy) cminy=miny; if (++maxy > cmaxy) cmaxy=maxy; break; case CLR_LG_WIN: /* clear the line graphics window */ XClearWindow(display,lg.win); XSetForeground(display, linegcclear, lg.pix[0]); XFillRectangle(display, lg.pixmap, linegcclear, 0, 0, lg.width, lg.height); cminx=0; cminy=0; cmaxx=lg.width; cmaxy=lg.height; break; case LG_MAX_DIM: /* return maximum lg dimensions */ bufcont[0]= htons(LG_MAX_DIM); bufcont[1]= htons(0); bufcont[2]= htons(LG_MAX_WIDTH-1); /* just so we're not too silly */ if (LG_MAX_WIDTH < lg.width) bufcont[2]= htons(lg.width-1); bufcont[3]= htons(0); bufcont[4]= htons(LG_MAX_HEIGHT-1); if (LG_MAX_HEIGHT < lg.height) bufcont[4]= htons(lg.height-1); bufcont[5]= htons(0); bufcont[6]= htons(lg.colors-1); buflen=7; break; case LG_SCALE: bufcont[0]= htons(LG_SCALE); bufcont[1]= htons(DisplayWidthMM(display,screen)); bufcont[2]= htons(DisplayHeightMM(display,screen)); bufcont[3]= htons(DisplayWidth(display,screen)); bufcont[4]= htons(DisplayHeight(display,screen)); buflen=5; break; case LG_DEF_SIZE: bufcont[0]= htons(LG_DEF_SIZE); bufcont[1]= htons(0); bufcont[2]= htons(lg.width-1); bufcont[3]= htons(0); bufcont[4]= htons(lg.height-1); buflen=5; break; case SET_LG_SIZE: /* set size of line graphics window */ if (len < 2) { savedshorts=len+1; --buf; break; } lg.imwidth= ntohs(*buf++); lg.imheight= ntohs(*buf++); len -= 2; /* now we get a pixmap for it. Resizing the window */ /* may override this, but if it does we won't lose */ /* data we obtained in the mean time */ temppixmap=XCreatePixmap(display, RootWindow(display,screen), lg.imwidth, lg.imheight, linedepth); XSetForeground(display, linegcclear, lg.pix[0]); XFillRectangle(display, temppixmap, linegcclear, 0, 0, lg.imwidth, lg.imheight); XCopyArea(display, lg.pixmap, temppixmap, linegc, 0, 0, lg.imwidth, lg.imheight, 0, 0); XFreePixmap(display, lg.pixmap); lg.pixmap=temppixmap; /* clear the window */ XFillRectangle(display, lg.win, linegcclear, 0, 0, lg.width, lg.height); lg.winxoff=(lg.width-lg.imwidth)/2; lg.winyoff=(lg.height-lg.imheight)/2; XCopyArea(display, lg.pixmap, lg.win, linegc, 0, 0, lg.imwidth, lg.imheight, lg.winxoff, lg.winyoff); XResizeWindow(display,lg.win,lg.imwidth,lg.imheight); break; case DRAW_DOT: if (len < 2) { savedshorts=len+1; --buf; break; } minx= ntohs(*buf++); miny= ntohs(*buf++); maxy=lglinewid>>1; if (lglinewid < 2) { XDrawPoint(display, lg.pixmap, linegc, minx, miny); if (--minx < cminx) cminx=minx; if (--miny < cminy) cminy=miny; minx += 2; miny += 2; if (minx > cmaxx) cmaxx=minx; if (miny > cmaxy) cmaxy=miny; } else { int radius = lglinewid/2; unsigned int diameter = radius*2; minx -= radius; miny -= radius; XFillArc(display, lg.pixmap, linegc, minx, miny, diameter, diameter, 0, 23040); if (--minx < cminx) cminx=minx; if (--miny < cminy) cminy=miny; minx += diameter+2; miny += diameter+2; if (minx > cmaxx) cmaxx=minx; if (miny > cmaxy) cmaxy=miny; } len -= 2; break; case FILL_POLY: if (!len) { savedshorts=1; --buf; break; } i= ntohs(*buf++); /* se if there's enough data */ if (--len < i*2) { savedshorts=len+2; buf -= 2; } #ifdef lint if (!malloc((unsigned)i*sizeof(XPoint))) #else if (!(points=(XPoint *)malloc( (unsigned)i*sizeof(XPoint)))) #endif { (void)fprintf(stderr,MSG_MALLOC); return(MALLOC_ERR); } j=0; minx=lg.width; maxx=0; miny=lg.height; maxy=0; while (i-- > 0) { if ((int)ntohs(*buf) < minx) minx= ntohs(*buf); if ((int)ntohs(*buf) > maxx) maxx= ntohs(*buf); points[j].x= ntohs(*buf++); if ((int)ntohs(*buf) < miny) miny= ntohs(*buf); if ((int)ntohs(*buf) > maxy) maxy= ntohs(*buf); points[j++].y= ntohs(*buf++); len -= 2; } XFillPolygon(display, lg.pixmap, linegc, points, j, Complex, CoordModeOrigin); free((char *)points); if (--minx < cminx) cminx=minx; if (++maxx > cmaxx) cmaxx=maxx; if (--miny < cminy) cminy=miny; if (++maxy > cmaxy) cmaxy=maxy; break; case FILL_RECT: if (len < 4) { savedshorts=len+1; --buf; break; } minx= ntohs(*buf++); miny= ntohs(*buf++); maxx= ntohs(*buf++); maxy= ntohs(*buf++); len -= 4; if (minx > maxx) { i=minx; minx=maxx; maxx=i; } if (miny > maxy) { i=miny; miny=maxy; maxy=i; } XFillRectangle(display, lg.pixmap, linegc, minx, miny, (unsigned)(maxx-minx), (unsigned)(maxy-miny)); if (--minx < cminx) cminx=minx; if (++maxx > cmaxx) cmaxx=maxx; if (--miny < cminy) cminy=miny; if (++maxy > cmaxy) cmaxy=maxy; break; case LG_LINE_WID: if (!len) { savedshorts=1; --buf; break; } lglinewid= ntohs(*buf++); XSetLineAttributes(display, linegc, lglinewid, LineSolid, CapRound, JoinRound); --len; break; case LG_PIXLINE: if (len < 4) { savedshorts=len+1; --buf; break; } npix= ntohs(*buf++); minx= ntohs(*buf++); miny= ntohs(*buf++); len -= 3; if (len < npix) { savedshorts=len+4; buf -= 4; break; } for (i=0 ; i < npix; ++i) { XSetForeground(display, linegc, lg.pix[(int)ntohs(*buf++) % lg.colors]); XDrawPoint(display, lg.pixmap, linegc, minx++, miny); } len -= npix; if (--minx < cminx) cminx=minx; if (minx+npix+2 > cmaxx) cmaxx=minx+npix+2; XSetForeground(display, linegc, lg.pix[lgcolor]); if (--miny < cminy) cminy=miny; if (miny+2 > cmaxy) cmaxy=miny+2; break; case SET_LG_CSCALE: tmpptr= (char *)buf; /* make sure that there are enough nulls in the data */ j=i=0; while (i < len*2 && j < 4) { if (tmpptr[i] == '\0') ++j; ++i; } if (j < 4) { savedshorts=len+1; --buf; break; } i= strlen(tmpptr) + 1; j= strlen(tmpptr+i) + 1; k= strlen(tmpptr+i+j) + 1; l= strlen(tmpptr+i+j+k) + 1; sscanf(tmpptr, "%e", &lg.curxoff); sscanf(tmpptr+i, "%e", &lg.curxsc); sscanf(tmpptr+i+j, "%e", &lg.curyoff); sscanf(tmpptr+i+j+k, "%e", &lg.curysc); if (lg.curxsc == 0.0) lg.curxsc=1.0; if (lg.curysc == 0.0) lg.curysc=1.0; buf += (i+j+k+l+1)/2; len -= (i+j+k+l+1)/2; break; case SHOW_BM_WIN: /* conceal/reveal bitmap graphics */ #ifdef PGDISP badbmcom=1; #endif ++buf; --len; /* isn't backwards compatibility nice? */ break; case SET_BM_LUT: /* set bitmap graphics LUTs */ #ifdef PGDISP badbmcom=1; if (len < 4) { savedshorts=len+1; --buf; } else { thislut= ntohs(*buf++); i= ntohs(*buf++); /* bits-per-pixel */ i= ntohs(*buf++); /* number affected */ j= ntohs(*buf++) & 0x7; /* the affected luts */ len -= 3; if (j && len < i || !j && len < 3*i) { savedshorts=len+4; buf -= 4; } else if (j) { len -= i; buf += i; } else { len -= 3*i; buf += 3*i; } } #else savedshorts=writeluts(&buf,&len); #endif break; case BM_SET_CURS: /* set the cursor location */ #ifdef PGDISP buf += 2; len -= 2; badbmcom=1; #else minx= ntohs(*buf++); miny= ntohs(*buf++); bmscurs(minx,miny); len -= 2; #endif break; case BM_GET_CURS: /* set and get cursor location */ #ifdef PGDISP badbmcom=1; #else /* get cursor location (must be done in mainloop) */ bufcont[0]= htons(BM_GET_CURS); buflen=4; if (bmgcurs(&bufcont[0])) { /* There's already an event there */ returnbuf(&bufcont[0],4,srcwin); buflen=0; } #endif break; case CLR_BM_WIN: /* clear the bitmap graphics window */ #ifdef PGDISP badbmcom=1; #else if (bppix == 16) { for (i=0, im16= rimdat.b16 ; i < bm.imwidth*bm.imheight ; ++i) *im16++ = 0; } else { for (i=0, im8= rimdat.b8 ; i < bm.imwidth*bm.imheight ; ++i) *im8++ = 0; } redrawim(0, 0, bm.imwidth-1, bm.imheight-1); (void)updateloc(); #endif break; case BM_MAX_DIM: /* return maximum bitmap dimensions */ #ifdef PGDISP badbmcom=1; #else /* This has no real relevance since it's only */ /* dependant on memory, but we need to return */ /* something. */ bufcont[0]= htons(BM_MAX_DIM); bufcont[1]= htons(0); bufcont[2]= htons(BM_MAX_WIDTH-1); /* don't be silly */ if (BM_MAX_WIDTH < bm.width) bufcont[2]= htons(bm.width-1); bufcont[3]= htons(0); bufcont[4]= htons(BM_MAX_HEIGHT-1); if (BM_MAX_HEIGHT < bm.height) bufcont[4]= htons(bm.height-1); bufcont[5]= htons(0); bufcont[6]= htons(BM_COLORS-1); buflen=7; #endif break; case BM_DEF_SIZE: #ifdef PGDISP badbmcom=1; #else bufcont[0]= htons(BM_DEF_SIZE); bufcont[1]= htons(0); bufcont[2]= htons(bm.imwidth-1); bufcont[3]= htons(0); bufcont[4]= htons(bm.imheight-1); buflen=5; #endif break; case SET_BM_SIZE: /* set size of image */ #ifdef PGDISP badbmcom=1; #endif if (len < 2) { savedshorts=len+1; --buf; break; } #ifdef PGDISP buf += 3; len -= 3; #else minx= ntohs(*buf++); miny= ntohs(*buf++); maxx= ntohs(*buf++); if (maxx != 16 && maxx != 8) { (void)fprintf(stderr, "Invalid bits-per-pixel (%d)!\n",maxx); (void)fprintf(stderr, "Assuming 8\n"); (void)fprintf(stderr, "Don't be surprised if things don't work\n"); maxx=8; } len -= 3; if (minx=resizeim(minx,miny,maxx)) return(minx); #endif break; case BM_WRITE: #ifdef PGDISP badbmcom=1; #endif if (len < 6) { savedshorts=len+1; --buf; break; } #ifdef PGDISP bppix= ntohs(*buf++); startx= ntohs(*buf++); starty= ntohs(*buf++); npix= ntohs(*buf++); nline= ntohs(*buf++); len -= 5; if (bppix == 16 && len < npix*nline || len < ((npix*nline+1)>>1)) { savedshorts=len+6; buf -= 6; break; } else if (bppix == 16) { buf += npix*nline; len -= npix*nline; } else { buf += ((npix*nline+1)>>1); len -= ((npix*nline+1)>>1); } #else /* get the image size - writeimage takes care of */ /* interpreting the rest of the arguments and */ /* changing buf and len accordingly */ minx= ntohs(*buf++); --len; if (minx == 16) savedshorts=writeimage16(&buf,&len); else savedshorts=writeimage(&buf,&len); #endif break; case SET_BM_CSCALE: #ifdef PGDISP badbmcom=1; #endif if (len < 6) { savedshorts=len+1; --buf; break; } #ifdef PGDISP buf += 6; len -= 6; #else bm.curxsc= (short)ntohs(*buf++); bm.curxsc /= (short)ntohs(*buf++); bm.curxoff= (short)ntohs(*buf++); bm.curysc= (short)ntohs(*buf++); bm.curysc /= (short)ntohs(*buf++); bm.curyoff= -bm.imheight - (short)ntohs(*buf++); if (bm.curxsc == 0.0) bm.curxsc=1.0; if (bm.curysc == 0.0) bm.curysc=1.0; len -= 6; #endif break; case SET_BM_DSCALE: #ifdef PGDISP badbmcom=1; #endif tmpptr= (char *)buf; /* make sure that there are enough nulls in the data */ j=i=0; while (i < len*2 && j < 2) { if (tmpptr[i] == '\0') ++j; ++i; } if (j < 2) { savedshorts=len+1; --buf; break; } i=strlen(tmpptr) + 1; j=strlen(tmpptr+i) + 1; #ifndef PGDISP sscanf(tmpptr,"%e", &bm.dsc); sscanf(tmpptr+i,"%e", &bm.doff); #endif buf += (i+j+1)/2; len -= (i+j+1)/2; break; case BM_FLUSH: #ifdef PGDISP badbmcom=1; #endif XFlush(display); break; case BM_LINE: #ifdef PGDISP badbmcom=1; #endif if (len < 5) { savedshorts=len+1; --buf; break; } #ifdef PGDISP buf += 5; len -= 5; #else minx= ntohs(*buf++); miny= ntohs(*buf++); maxx= ntohs(*buf++); maxy= ntohs(*buf++); drawline(minx,miny,maxx,maxy, ntohs(*buf++)); len -= 5; #endif break; case BM_ZOOMPAN: #ifdef PGDISP badbmcom=1; #endif if (len < 4) { savedshorts=len+1; --buf; break; } #ifdef PGDISP buf += 4; len -= 4; #else minx = ntohs(*buf++); miny = ntohs(*buf++); /* update our idea of the center */ if (minx > 0 && miny > 0) { i = bm.xoff; bm.xoff = minx; j = bm.yoff; bm.yoff = miny; if (bm.xzoom >= 0) bm.xoff -= (bm.width >> (bm.xzoom+1)); else if (bm.xzoom < -1) bm.xoff -= (bm.width << (-bm.xzoom-1)); else bm.xoff -= bm.width; if (bm.yzoom >= 0) bm.yoff -= (bm.height >> (bm.yzoom+1)); else if (bm.yzoom < -1) bm.yoff -= (bm.height << (-bm.yzoom-1)); else bm.yoff -= bm.height; checkoff(); } maxx = ntohs(*buf++); maxy = ntohs(*buf++); if (maxx != bm.xzoom && maxx < 30 || maxy != bm.yzoom && maxy < 30) zoomim(maxx, maxy); else if (i != bm.xoff || j != bm.yoff) { XFillRectangle(display, bm.win, bitgcclear, 0, 0, bm.width, bm.height); redrawim(display_to_imagecol(0), display_to_imagerow(0), display_to_imagecol(bm.width-1), display_to_imagerow(bm.height-1)); } /* update the cursor */ updatetitle(imagecol_to_display(minx), imagerow_to_display(miny), 0); len -= 4; #endif break; case SET_BM_SH_SIZE: #ifdef PGDISP badbmcom=1; if (len < 5) { savedshorts = len+1; --buf; break; } buf += 3; len -= 4; switch(ntohs(*buf++)) { case 1: /* Sun shared memory - the only kind so far */ if (len < 2) { savedshorts = len+5; buf -= 5; break; } break; } break; #else savedshorts=resizeshm(&buf, &len); #endif break; case BM_SH_UPDATE: #ifdef PGDISP badbmcom=1; #endif if (len < 4) { savedshorts = len+1; --buf; break; } #ifdef PGDISP buf += 4; len -= 4; #else minx = ntohs(*buf++); miny = ntohs(*buf++); maxx = ntohs(*buf++); maxy = ntohs(*buf++); /* all we need to do is update the display if shared */ /* memory is actually being used. */ if (shmtype != -1) { goodhist=0; redrawim(minx, miny, minx+maxx-1, miny+maxy-1); } len -= 4; #endif break; case DO_BOX: #ifdef PGDISP badbmcom=1; #else do_box(); #endif break; case DO_AUTODISP: #ifdef PGDISP badbmcom=1; #endif tmpptr= (char *)buf; /* make sure that there are enough nulls in the data */ j=i=0; while (i < len*2 && j < 2) { if (tmpptr[i] == '\0') ++j; ++i; } if (j < 2) { savedshorts=len+1; --buf; break; } i=strlen(tmpptr) + 1; j=strlen(tmpptr+i) + 1; buf += (i+j+1)/2; len -= (i+j+1)/2; #ifndef PGDISP sscanf(tmpptr,"%lg", &dtmp1); sscanf(tmpptr+i,"%lg", &dtmp2); if (dtmp2 <= dtmp1 || dtmp1 < 0.0 || dtmp2 > 100.0) { fprintf(stderr, "Ignoring invalid autodisp range.\n"); } else { if (autodisp_lower != dtmp1/100.0 || autodisp_upper != dtmp2/100.0) goodhist=0; autodisp_lower=dtmp1/100.0; autodisp_upper=dtmp2/100.0; } usehist=0; useramp=1; if (!goodhist) calchist(); imagescale(usehist, useramp); newmapping(); #endif break; case DO_HISTEQ: #ifdef PGDISP badbmcom = 1; #else /* * Scale the image. */ usehist = 1; useramp = 0; imagescale( usehist, useramp ); #endif break; case FIGDISP_IDLE: sendidle = 1; break; case FIGDISP_POINTS: if (len < 2) { savedshorts = len+1; --buf; break; } minx = ntohs (*buf++); maxx = ntohs (*buf++); len -= 2; if (len < 3*minx) { savedshorts = len + 3; buf -= 3; break; } #ifdef PGDISP badbmcom = 1; #else write_points (minx, maxx, buf); #endif len -= 3*minx; buf += 3*minx; break; default: /* unknown command */ (void)printf("Unknown command %d\n",ntohs(*(buf-1))); (void)printf("Ignoring rest of command buffer\n"); (void)fflush(stdout); len=0; break; } /* do we need to save any values for the next call? */ if (savedshorts) { len=0; #ifdef lint if (!(malloc( #else if (!(olddata=(short *)malloc( #endif (unsigned)savedshorts*sizeof(short)))) { (void)fprintf(stderr,MSG_MALLOC); return(MALLOC_ERR); } /* copy data */ for (i=0 ; i < savedshorts ; ++i) *olddata++ = *buf++; olddata -= savedshorts; } } #ifdef PGDISP /* if we got a bitmap graphics command in pgdisp, print a warning */ if (badbmcom) { (void)puts("Warning: received bitmap command in line "); (void)puts("graphics only mode!\n"); (void)puts( "Should you be running figdisp instead of pgdisp?\n"); } #endif /* if we used old data, free up the buffer */ if (usedolddata) free((char *)bothbuf); if (!savedshorts && buflen) { /* if there's no incomplete command and we need to send a message */ for (i=0 ; i < buflen ; ++i) retbuf[i]=bufcont[i]; *retbuflen=buflen; buflen=0; } #ifndef PGDISP /* now update the location window */ (void)updateloc(); #endif /* now update the screen if necessary */ if (lg.mapped && cmaxx >= cminx && cmaxy >= cminy) { XCopyArea(display, lg.pixmap, lg.win, linegc, cminx, cminy, (unsigned)(cmaxx-cminx), (unsigned)(cmaxy-cminy), cminx+lg.winxoff, cminy+lg.winyoff); } return(SUCCEED); } len -= i; buf += i; } else { len -= 3*i; buf += 3*i; } } #else savedshorts=writeluts(&buf,&len); #endif break; case BM_SET_CURS: /* set the cursor location */ #ifdef PGDISP buf += 2; len -= 2; badbmcom=1; #else minx= ntohs(*buf++); miny= ntohs(*buf++); bmscurs(minx,miny); len -= 2; #endif break; case BM_GET_CURS: /* set and get cursor locatpgplot/pgdispd/resizelgwin.c010064400040640000322000000036310537332242000166750ustar00tjpcitmbr00000400000017/* The resizelgwin routine updates the line graphics window in response to a */ /* ConfigureNotify event. */ /* Sam Southard, Jr. */ /* Created: 29-Mar-1991 (from figdisp/resizewin) */ /* Modification History: */ /* 2-Apr-1991 SNS/CIT Modified to use a Pixmap the same size as the window, */ /* instead of always having a LG_MAX_xxx sized pixmap. */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ /* 11-Feb-1992 SNS/CIT Elimincated some unnecessary code. */ /* 14-Feb-1992 SNS/CIT Now clears the line graphics window to lg.pix[0] */ /* instead of BlackPixel */ /* 10-Apr-1992 SNS/CIT No longer uses minimum or maximum window sizes. Now */ /* uses lg.imwidth & lg.imheight as the width & height */ /* of the pixmap. */ /* The program include files */ #include "figdisp.h" #include "globals.h" void resizelgwin(event) XConfigureEvent event; { int changed=0; /* whether or not we need to resize the window again */ static int lastchanged=0; /* if we changed last time through */ Pixmap temppixmap; /* pixmap to hold old data */ Pixmap XCreatePixmap(); lg.width=lg.imwidth=event.width; lg.height=lg.imheight=event.height; /* I know that this won't work right now (changed never gets set). */ /* However, I'm keeping it around until I know how to detect if */ /* XCreatePixmap failed */ if (changed && !lastchanged) { lastchanged=1; XResizeWindow(display,lg.win,lg.width,lg.height); } else { lastchanged=0; temppixmap=XCreatePixmap(display, RootWindow(display,screen), lg.width, lg.height, linedepth); /* Clear the pixmap */ XSetForeground(display, linegcclear, lg.pix[0]); XFillRectangle(display, temppixmap, linegcclear, 0, 0, lg.width, lg.height); XCopyArea(display, lg.pixmap, temppixmap, linegc, 0, 0, lg.width, lg.height, 0, 0); XFreePixmap(display, lg.pixmap); lg.pixmap=temppixmap; XCopyArea(display, lg.pixmap, lg.win, linegc, 0, 0, lg.width, lg.height, 0, 0); } return; } pgplot/pgdispd/returnbuf.c010064400040640000322000000016230537332242000163460ustar00tjpcitmbr00000400000017/* The returnbuf routine sends a message back to the client program. It */ /* allows only one message to be sent to the client at a time - the client */ /* must ensure that it gets a value before asking for the next one. */ /* Sam Southard, Jr. */ /* Created: 19-Nov-1990 */ /* Modification History: */ /* 15-Aug-1991 SNS/CIT No longer includes hooks for Xvideo */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ #include "figdisp.h" #include "globals.h" /* The X Window include files */ #include #include void returnbuf(msg,len,destwin) short *msg; /* the message to send to the client. */ int len; /* The length of the message. */ Window destwin; /* The window who's atom should be changed. */ { /* If the window is still around, then send the reply */ if (selset) XChangeProperty(display,destwin,selatom,XA_STRING,8, PropModeReplace,(unsigned char *)msg,len*2); return; } pgplot/pgdispd/updatelgtitle.c010064400040640000322000000037000537332242100172000ustar00tjpcitmbr00000400000017/* The updatelgtitle image updates the line graphics window's title to */ /* reflect the position of the cursor. The arguments are the window x and y */ /* position of the cursor event */ /* Sam Southard, Jr. */ /* Created: 12-Feb-1992 (from updatetitle.c) */ /* Modification History: */ /* 14-Feb-1992 SNS/CIT Now includes the id in the title */ /* 26-Feb-1992 SNS/CIT Now handles more than 16 colors */ /* 8-Apr-1992 SNS/CIT Keck title now more appropriate */ /* 10-Apr-1992 SNS/CIT Can now deal with lg.winxoff and lg.winyoff */ /* 4-Oct-1992 SNS/CIT No longer needs #ifdef KECK */ #include "figdisp.h" #include "globals.h" #include #include void updatelgtitle(x,y) int x,y; /* cursor position */ { char newtitle[80]; char tempstr[80]; char *strptr= &newtitle[0]; /* for the call to set the name */ double curx,cury; /* the cursor values */ int datval; XImage *image; int i; #ifndef _AIX char *sprintf(); #endif /* make sure we don't confuse anything. */ if (x < lg.winxoff || x >= lg.imwidth+lg.winxoff || y < lg.winyoff || y >= lg.imheight+lg.winyoff) return; else { /* now we can get the transformed values */ if ((image=XGetImage(display, lg.pixmap, x-lg.winxoff, y-lg.winyoff, 1, 1, 0xFFFFFFFF, ZPixmap)) == NULL) { datval= -1; } else { datval=XGetPixel(image,0,0); XDestroyImage(image); } for (i=0 ; i < lg.colors ; ++i) { if (datval==lg.pix[i]) { datval=i; break; } } if (i >= lg.colors) datval= -1; curx=x-lg.winxoff; cury=lg.height-(y-lg.winyoff)-1; curx=(curx-lg.curxoff)/lg.curxsc; cury=(cury-lg.curyoff)/lg.curysc; if (datval < 0) (void)sprintf(&newtitle[0], "line graphics #%d X: %.6g Y: %.6g", res.id, curx, cury); else (void)sprintf(&newtitle[0], "line graphics #%d X: %.6g Y: %.6g Color Index: %d", res.id, curx, cury, datval); } if (XStringListToTextProperty(&strptr, 1, &lg.winname)) XSetWMName(display, lg.win, &lg.winname); return; } pgplot/pgdispd/waitevent.c010064400040640000322000000071450565753343300163620ustar00tjpcitmbr00000400000017/* The waitevent routine waits until there are events in the queue. If the */ /* program which was feeding us data goes away then it grabs ownership of the */ /* selection so that the next program will be able to access things. */ /* Return Value: */ /* 0 The program feeding us data died. */ /* -1 We could not get ownership of the selection atom */ /* 1 If everything went fine. */ /* Sam Southard, Jr. */ /* Created: 12-Dec-1990 from mainloop.c */ /* 13-Dec-1990 SNS/CIT Now calls writeimage to clean up its state if the */ /* connection goes away */ /* 15-Aug-1991 SNS/CIT No longer includes hooks for xvideo */ /* 6-Sep-1991 SNS/CIT Modified to lint cleanly */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ /* 22-Nov-1991 SNS/CIT Should now only be called if we think there's a */ /* client program out there (selset argument removed). */ /* Now gets the time to wait between existance checks */ /* from an X resource */ /* 27-Nov-1991 SNS/CIT Modified to lint cleanly */ /* 29-Jan-1992 SNS/CIT Now uses the correct method to check if an event is */ /* pending, instead of using the QLength macro (which */ /* was an error) */ /* 30-Jan-1992 SNS/CIT Now uses the XEventsQueued call to determine if an */ /* event is pending. This means we don't have to push */ /* events back on the list. */ /* * On AIX systems we need to define _BSD before including sys/types.h, * to get select() types defined. */ #ifdef _AIX #define _BSD #endif /* The system include files */ #include #include #include /* The X11 include files */ #include /* The program include files */ #include "figdisp.h" #include "globals.h" #include "messages.h" #include "commands.h" /* Choose one of the following to select either good response time or low */ /* system load, keeping in mind what your system provides. If none of the */ /* following defines is chosen, BUSY is used. */ /* #define BUSY /* Busy loop while waiting for events. This loads */ /* system but gives quickest response time and is */ /* ompletely portable (since it does nothing). */ /* #define SLEEP /* Use the sleep(3) call to wait between existance */ /* checks. This is much nicer on the system load but */ /* gives poor response time. */ /* #define SELECT /* Use this if possible. */ #ifdef VMS #define WAIT /* use the LIB$WAIT call */ #else #define SELECT /* Use the select call to wait */ #endif int waitevent() { short retbuf; #ifdef WAIT float waittime; waittime=(1e-6)*res.sleeptime; #endif #ifdef SLEEP int sleeptime; if ((sleeptime=res.sleeptime/1000000) < 1) sleeptime=1; #endif #ifdef SELECT struct timeval timeout; #endif while (!XEventsQueued(display,QueuedAlready)) { XFlush(display); /* if the selection is not owned we need to grab it again */ if (XGetSelectionOwner(display,selatom) == None) { XSetSelectionOwner(display,selatom,lg.win,CurrentTime); if (XGetSelectionOwner(display,selatom) != lg.win) { (void)fprintf(stderr,MSG_BADSELOWN); return(-1); } XUngrabKeyboard(display,CurrentTime); (void)proccom((short *)NULL,0,(short *)NULL,(int *)0); return(0); /* the selection owner was reset */ } /* give the idle message if the user's asked for it */ if (sendidle) { retbuf = FIGDISP_IDLE; returnbuf (&retbuf, 1, srcwin); sendidle = 0; } /* pause a while */ #ifdef SLEEP sleep(sleeptime); #endif #ifdef WAIT lib$wait(&waittime); #endif #ifdef SELECT timeout.tv_sec = 0; timeout.tv_usec = res.sleeptime; select (0, (fd_set *)NULL, (fd_set *)NULL, (fd_set *)NULL, &timeout); #endif } return(1); /* the selection owner was not reset */ } de files */ #include "figdisp.h" #include "globals.h" #include "messages.h" #include "commands.h" /* Choose one of the following to select either good response time or low */ /* system load, keeping in mind what your system provides. If none of the */ /* following defines is chosen, BUSY is used. */ /* #define BUSY /* Busy loop while waiting for events. This loads */ /* system but gives quickest responpgplot/pgdispd/handlexevent.c010064400040640000322000000313250554662535000170330ustar00tjpcitmbr00000400000017/* The handlexevent routine takes care of a single X event for the figdisp */ /* display server. */ /* Return Values: */ /* FAIL If something went wrong */ /* SUCCEED If the user requested an exit */ /* Sam Southard, Jr. */ /* Created: 3-Dec-1991 (from figdisp mainloop.c) */ /* Modification History: */ /* 30-Jan-1992 SNS/CIT Keck mods merged back into standard display server */ /* 31-Jan-1992 SNS/CIT All motion events until a button event are now read */ /* before any action is taken. This drastically */ /* improves response times on X terminals */ /* 6-Apr-1992 SNS/CIT Now uses large crosshairs cursor for line graphics. */ /* Now handles the case when a button release event is */ /* lost. */ /* 8-Apr-1992 SNS/CIT Buttonrelease lost recovery code added to LUT */ /* manipulation button. No longer sets active line */ /* graphics color to 1 when drawing cursor. */ /* 10-Apr-1992 SNS/CIT Now handles lg.winxoff & lg.winyoff */ /* 7-May-1992 SNS/CIT Now handles res.lgcross */ /* 27-Sep-1992 SNS/CIT Return buffer now stored in network byte order */ /* 30-Sep-1992 SNS/CIT LUT_WRAP no longer defined at compile time. RCS id */ /* string added. Now allows the addition of an offset */ /* into the color map. */ /* 4-Oct-1992 SNS/CIT No longer needs #ifdef KECK */ /* 14-Oct-1992 SNS/CIT Merged in changes from ARC/HI. */ #ifndef lint static char rcsid[]="@(#)$Id: handlexevent.c,v 1.12 1993/10/08 00:02:48 figaro Exp figaro $"; #endif /* The system include files */ #include #include #include /* The X Window include files */ #include #include #include /* The program include files */ #include "commands.h" #include "figdisp.h" #include "globals.h" #include "messages.h" int luttransoff=0; int modluttransoff=0; int handlexevent(event,go_on) XEvent event; int *go_on; /* whether the calling routine shoudl exit successfully */ { #ifndef PGDISP static int slitxs= -1,slitys; /* the starting point for the slit */ static int slitxe= -1,slitye; static int xorlinedrawn=0; int nluts; /* the number of LUTs in the current image */ static int moffx,moffy; /* The starting coordinates for LUT offset */ /* modification (Ctrl-M1) */ #endif int px,py; /* The pointer X & Y position */ XEvent event2; /* A second event */ static short retbuf[7]; /* A buffer for return values */ static int retbuflen=0; /* the actual length of the buffer */ static int lgx= -1 ,lgy; /* current line graphics line pos */ Window windum; int dummy; unsigned int keys; void returnbuf(); /* return data to user program */ void resizelgwin(); /* resize line graphics window */ void exposelgwin(); /* expose the line graphics window */ void updatelgtitle(); /* update the line graphics cursor position */ #ifndef PGDISP void updatetitle(); void exposesee(); /* expose the seeing window */ void resizebmwin(); /* resize the bitmap graphics window */ void transluts(); /* map the LUT data into the LUTs we have */ void transim(); /* translate the image window */ void panpatch(); /* pan the patch window */ void panloc(); /* pan the location window */ void zoomim(); /* set the image zoom factor */ void exposebmwin(); /* expose the bitmap graphics window */ void exposepatch(); /* expose the patch window */ void exposecmap(); /* expose the color map window */ void doslit(); /* make a line plot */ #endif switch(event.type) { case SelectionClear: /* Unless this is a selection atom, ignore it */ if (event.xselectionclear.selection != selatom) break; /* someone's grabbed the selection, get ready for some data */ if (!selset) { if ((srcwin=XGetSelectionOwner(display, selatom)) == None) { (void)fprintf(stderr,MSG_NOSELOWN); return(FAIL); } selset=1; } XConvertSelection(display, selatom, XA_STRING, dataatom, lg.win, event.xselectionclear.time); break; case SelectionNotify: /* someone sent us data! */ *go_on=getdata(event.xselection, &retbuf[0], &retbuflen, srcwin, &selset); break; case Expose: if (event.xexpose.window == lg.win) exposelgwin(event.xexpose); #ifndef PGDISP else if (event.xexpose.window == bm.win) exposebmwin(event.xexpose.x, event.xexpose.y, event.xexpose.width, event.xexpose.height); else if (event.xexpose.window == patch.win) exposepatch(); else if (event.xexpose.window == box.win) exposebox(); else if (event.xexpose.window == loc.win) { if (updateloc()) return(FAIL); } else if (event.xexpose.window == cwin.win) exposecmap(event.xexpose); else if (event.xexpose.window == seeing.win) exposesee(); #endif break; case ConfigureNotify: if (event.xconfigure.window == lg.win) resizelgwin(event.xconfigure); #ifndef PGDISP else if (event.xconfigure.window == bm.win) resizebmwin(event.xconfigure); else if (event.xconfigure.window == patch.win) { patch.width=event.xconfigure.width; patch.height=event.xconfigure.height; } else if (event.xconfigure.window == loc.win) { if (resizeloc(event.xconfigure.width, event.xconfigure.height)) return(FAIL); } else if (event.xconfigure.window == cwin.win) if (resizecmap(event.xconfigure.width, event.xconfigure.height)) return(FAIL); #endif break; #ifndef PGDISP case ButtonRelease: if (event.xbutton.window == bm.win) { if (event.xbutton.button == Button3) { bm.modlut=0; /* reset the color tables? */ if (abs(event.xbutton.x -bm.mlx)< 10 && abs(event.xbutton.y - bm.mly) < 10) { if (bppix == 16) nluts=65536; else nluts=256; bm.slope=(nluts-1) / (double)(bm.colors-1); bm.offset=0; transluts(); } } else if (event.xbutton.button == Button2) { /* it's possible that this has already been */ /* taken care of, so drawing the line would */ /* not be a good idea */ if (slitxs < 0) break; /* erase the old line */ if (xorlinedrawn) XDrawLine(display, bm.win, xorgc, slitxs, slitys, slitxe, slitye); doslit(display_to_imagecol(slitxs), display_to_imagerow(slitys), display_to_imagecol(event.xbutton.x), display_to_imagerow(event.xbutton.y)); slitxe=slitxs= -1; xorlinedrawn=0; } else if (event.xbutton.button == Button1 && modluttransoff) { modluttransoff=0; if (abs(event.xbutton.x - moffx) < 10 && abs(event.xbutton.y - moffy) < 10) { luttransoff=0; } else { if (bppix == 16) luttransoff= (65536* (event.xbutton.x - (int)bm.width/2)) /((int)bm.width/2); else luttransoff= (256* (event.xbutton.x - (int)bm.width/2)) /((int)bm.width/2); } transluts(); } } break; #endif case MotionNotify: if (event.xbutton.window == lg.win) { /* absorb all motion events inside this window */ px=event.xbutton.x; py=event.xbutton.y; while(XCheckMaskEvent(display, PointerMotionMask, &event2) != False) { if (event2.xbutton.window != lg.win) break; px=event2.xbutton.x; py=event2.xbutton.y; } updatelgtitle(px-lg.winxoff,py-lg.winyoff); /* don't go further unless using crosshair cursor */ if (!res.lgcross) break; /* update the croshairs cursor */ if (lgx != -1) { /* first we clear the old lines */ XDrawLine(display, lg.win, linegcclear, 0, lgy, lg.width-1, lgy); XDrawLine(display, lg.win, linegcclear, lgx, 0, lgx, lg.height-1); /* we know that lgy and lgx are at least */ /* non-negative */ if (lg.winyoff < lgy && lgy-lg.winyoff < lg.imheight) XCopyArea(display, lg.pixmap, lg.win, linegc, 0, lgy-lg.winyoff, lg.width, 1, 0, lgy); if (lg.winxoff < lgx && lgx-lg.winxoff < lg.imwidth) XCopyArea(display, lg.pixmap, lg.win, linegc, lgx-lg.winxoff, 0, 1, lg.height, lgx, 0); } lgx=px; lgy=py; XSetForeground(display, linegcclear, lg.pix[1]); XDrawLine(display, lg.win, linegcclear, 0, lgy, lg.width-1, lgy); XDrawLine(display, lg.win, linegcclear, lgx, 0, lgx, lg.height-1); XSetForeground(display, linegcclear, lg.pix[0]); } #ifndef PGDISP if (event.xbutton.window != bm.win) break; /* absorb all motion events until the next button press or */ /* release */ px=event.xbutton.x; py=event.xbutton.y; while (XCheckMaskEvent(display, ButtonPressMask | ButtonReleaseMask | PointerMotionMask, &event2) != False) { switch(event2.type) { case ButtonPressMask: /* press or release ends */ case ButtonReleaseMask: /* processing */ XPutBackEvent(display,&event2); break; default: px=event2.xbutton.x; py=event2.xbutton.y; continue; /* the while loop */ break; } /* this will break out of the while loop if we got a */ /* press or release event */ break; } if (modluttransoff) { modluttransoff=1; if (bppix == 16) luttransoff= (65536* (event.xbutton.x -(int)bm.width/2))/((int)bm.width/2); else luttransoff= (256* (event.xbutton.x -(int)bm.width/2))/((int)bm.width/2); transluts(); } if (bm.modlut) { double scale; if (px < 0) px=0; if (px >= bm.width) px=bm.width-1; if ((py=bm.height-py-1) <= 0) py=1; if (py >= bm.height) py=bm.height-1; if (bppix==16) nluts=65536; else nluts=256; bm.slope=nluts/(1.5*py); scale=2*nluts*((double)px/bm.width -0.5); bm.offset=(1.0-scale)*bm.slope+(nluts>>1); scale=(nluts-1)/(double)(bm.colors-1); bm.offset = (bm.offset+0.5)/scale; transluts(); /* Make sure the pointer hasn't been released */ if (XQueryPointer(display, bm.win, &windum, &windum, &dummy, &dummy, &px, &py, &keys) == True && !(keys & Button3Mask)) { bm.modlut=0; /* reset the color tables? */ if (abs(event.xbutton.x -bm.mlx)< 10 && abs(event.xbutton.y - bm.mly) < 10) { if (bppix == 16) nluts=65536; else nluts=256; bm.slope=(nluts-1) / (double)(bm.colors-1); bm.offset=0; transluts(); } } } else updatetitle(px,py,0); if (slitxs > 0) { /* erase old line */ if (xorlinedrawn) XDrawLine(display, bm.win, xorgc, slitxs, slitys, slitxe, slitye); slitxe=px; slitye=py; if (XQueryPointer(display, bm.win, &windum, &windum, &dummy, &dummy, &px, &py, &keys) == True && !(keys & Button2Mask)) { /* the button was released, so handle it */ doslit(display_to_imagecol(slitxs), display_to_imagerow(slitys), display_to_imagecol(slitxe), display_to_imagerow(slitye)); slitxe=slitxs= -1; xorlinedrawn=0; } else { /* draw a new line */ XDrawLine(display, bm.win, xorgc, slitxs, slitys, slitxe, slitye); xorlinedrawn=1; } } #endif break; case ButtonPress: /* currently used only for cursor */ #ifndef PGDISP if (event.xbutton.window == bm.win) { if (event.xbutton.button == Button3) { if (mousemode == 0) { /* color map */ bm.modlut=1; bm.mlx=event.xbutton.x; bm.mly=event.xbutton.y; } else { /* box lower right */ lr_x = display_to_imagecol( event.xbutton.x); lr_y = display_to_imagerow( event.xbutton.y); do_box(); } } else if (event.xbutton.button == Button2){ if (slitxs >= 0) break; xorlinedrawn=0; slitxs=event.xbutton.x; slitys=event.xbutton.y; } else if (event.xbutton.button == Button1) { if (mousemode == 0) { /* new center */ if (event.xbutton.state & ControlMask) { modluttransoff=1; moffx=event.xbutton.x; moffy=event.xbutton.y; if (bppix == 16) luttransoff= (65536*(event.xbutton.x - (int)bm.width/2)) /((int)bm.width/2); else luttransoff= (256* (event.xbutton.x -(int)bm.width/2)) /((int)bm.width/2); transluts(); } else transim(event.xbutton); } else { /* box upper left */ ul_x = display_to_imagecol( event.xbutton.x); ul_y = display_to_imagerow( event.xbutton.y); do_box(); } } break; } else if (event.xbutton.window == patch.win) { panpatch(event.xbutton); break; } else if (event.xbutton.window == loc.win) { panloc(event.xbutton); break; } #endif case KeyPress: #ifndef PGDISP /* we could have fallen through */ if (event.type == KeyPress) { if ((*go_on=dokey(event.xkey)) == 1) break; if (*go_on == 0) return(SUCCEED); } #endif /* record this keypress for return to a user program if the */ /* program is trying to get the cursor location */ if (selset && (event.xany.window == lg.win && pgcursor(event) #ifndef PGDISP || event.xany.window == bm.win && bmcursor(event) #endif )) { if (retbuflen && (ntohs(retbuf[0]) == LG_CURS && pggcurs(&retbuf[0]) #ifndef PGDISP || ntohs(retbuf[0]) == BM_GET_CURS && bmgcurs(&retbuf[0]) #endif )) { /* the user's asked for one */ returnbuf(&retbuf[0],4,srcwin); retbuflen=0; } } break; } return(SUCCEED); } == bm.win) { if (event.xbutton.button == Button3) { bm.modlut=0; /* reset the color tables? */ if (abs(event.xbutton.x -bm.mlx)< 10 && abs(event.xbutton.y - bm.mly) < 10) { if (bppix == 16) nluts=65536; else nluts=256; bm.slope=(nluts-1) / (doubpgplot/pgdispd/initlgwin.c010064400040640000322000000137750572342070400163540ustar00tjpcitmbr00000400000017/* The initlgwin routine initializes the window we need to do line graphics */ /* (either PGPLOT or row/column printout */ /* Return Values: */ /* FAIL If something prevented us from doing all we needed to */ /* SUCCEED If everything went fine */ /* Sam Southard, Jr. */ /* Created: 13-Mar-1991 (from figdisp/initwins) */ /* 31-Jul-1991 SNS/CIT Now uses the visual member of the wininfo structure */ /* 15-Aug-1991 SNS/CIT No longer includes hooks for vista */ /* 6-Sep-1991 SNS/CIT Changes from SSL::TENNANT implemented */ /* 19-Sep-1991 SNS/CIT Now uses the Keck icon */ /* 3-Oct-1991 SNS/CIT Now initializes zfac structure member */ /* 8-Oct-1991 SNS/CIT Globals now in globals.h */ /* 10-Oct-1991 SNS/CIT Window manager hints now in initwmattr */ /* 22-Oct-1991 SNS/CIT No longer sets the border pixel */ /* 25-Nov-1991 SNS/CIT X and Y zoom now separate */ /* 29-Jan-1992 SNS/CIT Modifications for the Keck data acquisition system */ /* folded in. */ /* 11-Feb-1992 SNS/CIT Now looks for pointer motion masks */ /* 14-Feb-1992 SNS/CIT Now clears the pixmap to lg.pix[0], not BlackPixel. */ /* Now includes the id in the title */ /* 24-Feb-1992 SNS/CIT Visual allocation now done in the getvisuals routine */ /* 26-Feb-1992 SNS/CIT Cursor scaling offsets initialization added. */ /* 6-Apr-1992 SNS/CIT Now uses a blank cursor so that we can have large */ /* crosshairs as our cursor */ /* 8-Apr-1992 SNS/CIT Now has a better title for Keck version */ /* 10-Apr-1992 SNS/CIT No longer uses minimum or maximum window widths. Now */ /* uses lg.imwidth & lg.imheight as the width & height */ /* of the Pixmap */ /* 7-May-1992 SNS/CIT Now respects .lg.crosshair. */ /* 25-Jun-1992 SNS/CIT Now flushes the connection before returning. */ /* 4-Oct-1992 SNS/CIT No longer needs #ifdef KECK */ /* The system include files */ #include /* the X Window include files */ #include #include /* The program include files */ #include "figdisp.h" #include "globals.h" #include "messages.h" #include "figdisp.icon" #include "nocursor.icon" #define MAX_DEPTH 25 /* Must be greater than the maximum depth */ /* supported by X Window */ int initlgwin() { XSetWindowAttributes winattr; /* window attributes */ XGCValues gcvals; /* for setting the graphics context */ char wintitle[80]; /* The window's title */ unsigned long pmtmp[1]; /* temporary for plane masks */ XVisualInfo vTemplate; /* The template for our visual */ XVisualInfo *visualList; /* The visuals which matched */ int visualsMatched; /* how many matched? */ int newmap; /* do we need our own color map */ Pixmap lgcurspmap; /* pixmap for line graphics cursor */ int valuemask; /* the values set in XCreateWindow */ Window foobar; Pixmap XCreatePixmap(); void initlgluts(); /* initialize the LUTs */ char *malloc(); void initwmattr(); /* Initialize the line graphics LUTs */ initlgluts(); /* initialize the line graphics wininfo structure */ lg.height=lg.imheight=res.lggeo.h; lg.width=lg.imwidth=res.lggeo.w; lg.cursx=lg.width>>1; lg.cursy=lg.height>>1; lg.xzoom=lg.yzoom=0; lg.curxsc=lg.curysc=1.0; lg.curxoff=lg.curyoff=0.0; lg.winxoff=lg.winyoff=0; /* Load the cursor icon */ if (res.lgcross) { XColor bg; /* Background cursor color */ XColor fg; /* Foreground cursor color */ /* Query the X-server for the background and foreground colors */ bg.pixel = lg.pix[0]; XQueryColor(display, linecmap, &bg); fg.pixel = lg.pix[1]; XQueryColor(display, linecmap, &fg); lgcurspmap=XCreateBitmapFromData(display, RootWindow(display,screen), nocursor_bits, nocursor_width, nocursor_height); winattr.cursor=XCreatePixmapCursor(display, lgcurspmap, None, &fg, &bg, 0, 0); } /* create a window for line graphics */ winattr.background_pixmap=None; winattr.background_pixel=lg.pix[0]; winattr.colormap=linecmap; winattr.border_pixel=lg.pix[0]; winattr.bit_gravity=SouthWestGravity; valuemask= CWBackPixel | CWColormap | CWBitGravity | CWBackPixmap | CWBorderPixel; if (res.lgcross) valuemask |= CWCursor; lg.win=XCreateWindow(display, RootWindow(display,screen), res.lggeo.x, res.lggeo.y, lg.width, lg.height, BORDER_WIDTH, (int)linedepth, InputOutput, linevisual, valuemask, &winattr); lg.mapped=0; /* it's not mapped yet */ /* Load the icon */ lg.icon=XCreateBitmapFromData(display, lg.win, (char *)&figdisp_bits[0], figdisp_width, figdisp_height); /* set up the window manager hints */ (void)sprintf(&wintitle[0],"line graphics #%d",res.id); initwmattr(lg, &wintitle[0], "line graphics", &res.lggeo); /* The lock and selection atoms need to be owned by someone */ XSetSelectionOwner(display,lock,lg.win,CurrentTime); XSetSelectionOwner(display,selatom,lg.win,CurrentTime); /* was there a problem owning the locking atom? */ if (XGetSelectionOwner(display,lock) != lg.win) (void)fprintf(stderr,MSG_NOLOCK); /* if we can't get ownership of the selection atom, we won't */ /* be able to receive any commands */ if (XGetSelectionOwner(display,selatom) != lg.win) { (void)fprintf(stderr,MSG_BADSELOWN); return(-1); } /* Create the line graphics pixmap */ lg.pixmap=XCreatePixmap(display, RootWindow(display,screen), lg.width, lg.height, linedepth); /* set up a graphics contexts for the line graphics window */ gcvals.foreground=lg.pix[0]; linegcclear=XCreateGC(display,lg.win,GCForeground,&gcvals); gcvals.background=lg.pix[0]; gcvals.foreground=lg.pix[1]; gcvals.fill_style=FillSolid; gcvals.fill_rule=EvenOddRule; linegc=XCreateGC(display, lg.win, GCForeground|GCBackground|GCFillStyle|GCFillRule,&gcvals); XSetFont(display, linegc, res.textfont->fid); XSetFont(display, linegcclear, res.textfont->fid); /* Clear the pixmap */ XFillRectangle(display, lg.pixmap, linegcclear, 0, 0, lg.width, lg.height); /* we need to listen for new data */ XSelectInput(display,lg.win,PropertyChangeMask | ExposureMask | StructureNotifyMask | ButtonPressMask | PointerMotionMask | KeyPressMask); XFlush(display); return(SUCCEED); } igdpgplot/pgdispd/resdb.c010064400040640000322000001174750565755276100154700ustar00tjpcitmbr00000400000017/* The routines in this file manipulate the X11 resource databases */ /* Sam Southard, Jr. */ /* Created: 4-Oct-1991 */ /* 7-Oct-1991 SNS/CIT Handling of patch, cmap, and location geometries and */ /* min and max shared and private colors added. Now */ /* handles specification of keycodes */ /* 8-Oct-1991 SNS/CIT Global variables moved into globals.h. -geometry now */ /* sets lg.geometry in the pgdisp version. */ /* 9-Oct-1991 SNS/CIT Now handles font initialization */ /* 22-Nov-1991 SNS/CIT Now handles specifying that output go to a file */ /* instead of directly to a printer, printer should be */ /* used for output, how long to wait between checks to */ /* make sure the client program is still there, */ /* forcing the location window pixels to be square, and */ /* the number of colors to be copied from the default */ /* colormap to a private color map. */ /* 25-Nov-1991 SNS/CIT Now handles separate zooming in X & Y and flipping */ /* points in a line graph so that they always go from */ /* left to right */ /* 27-Nov-1991 SNS/CIT Now handles figdisp.line.ascending */ /* 31-Jan-1992 SNS/CIT Now handles figdisp.leaveColors */ /* 14-Feb-1992 SNS/CIT Now handles figdisp.id to allow specification of */ /* multiple figdisps/pgdisps. */ /* 18-Feb-1992 SNS/CIT Resource lookup now works no matter what the program */ /* is called. Help message updated to show new options. */ /* Now handles figdisp.lineColors */ /* 3-Mar-1992 SNS/CIT Now handles figdisp.visual. */ /* 14-Apr-1992 SNS/CIT Now compiles under VMS */ /* 7-May-1992 SNS/CIT Now handles figdisp.lg.crosshair. */ /* 24-Jun-1992 SNS/CIT Now handles .histogram and .histgeometry */ /* 25-Jun-1992 SNS/CIT Now handles .line.histogram. */ /* 30-Sep-1992 SNS/CIT LUT wrap resources added. RCS id string added. */ /* 14-Sep-1992 SNS/CIT Modifications from ARC/HI merged in. */ /* 4-Nov-1992 SNS/CIT No longer includes malloc.h */ /* 16-Nov-1992 SNS/CIT resetLUTWrap added into resource table. */ #ifndef lint static char rcsid[]="@(#)$Id: resdb.c,v 1.13 1993/10/08 00:02:48 figaro Exp figaro $"; #endif #include "figdisp.h" #include "globals.h" #include #include #include #include #include #ifndef VMS #include #endif #ifdef solaris #include #endif #ifdef VMS #define KEY_HELP XK_F1 /* help button */ #define KEY_ZOOM_IN XK_F2 /* key to zoom in */ #define KEY_ZOOM_0 XK_F3 /* go to normal size image */ #define KEY_ZOOM_OUT XK_F4 /* key to zoom out */ #define KEY_CMAP XK_F5 /* key to toggle display of color map window */ #define KEY_CUR_TOG XK_F6 /* key to toggle cursor output */ #define KEY_RECENTER XK_F7 /* to to recenter image */ #define KEY_LOC_TOG XK_F8 /* key to toggle the show location window */ #define KEY_QUIT XK_F9 /* key to quit */ #define KEY_PAT_TOG XK_F10 /* key to show/update/hide patch window */ #define KEY_ROW XK_L1 /* key to produce a row plot */ #define KEY_COL XK_L2 /* key to produce a column plot */ #define KEY_IMPS XK_L3 /* key to print the entire image on the */ /* PostScript printer PRINTER. */ #define KEY_WINPS XK_L4 /* key to print the visible portion of the */ /* image on the PostScript printer PRINTER. */ #define KEY_INHIBIT XK_L6 /* inhibit other key interpretations */ #define KEY_INVERT XK_L8 /* key to invert the color maps */ #define KEY_SEE_TOG XK_L9 /* key to show/update/hide the seeing window */ #define KEY_SLDEC XK_comma /* key to decrease slit width */ #define KEY_SLINC XK_period /* key to increase slit width */ #define KEY_SLRES XK_slash /* key to reset slit width */ #define KEY_HIST XK_KP_F1 /* key to use histogram equalization */ #define KEY_ZOOMY_IN XK_KP_1 /* Zoom in Y only */ #define KEY_ZOOMY_OUT XK_KP_3 /* Zoom in Y only */ #define KEY_ZOOMX_IN XK_KP_7 /* Zoom in X only */ #define KEY_ZOOMX_OUT XK_KP_9 /* Zoom in X only */ #define KEY_LWRAP_INC XK_greater /* increase the LUT wrap */ #define KEY_LWRAP_DEC XK_less /* decrease the LUT wrap */ #define KEY_LWRAP_RES XK_question /* reset the LUT wrap */ #define KEY_MOUSEMODE XK_R2 /* key to change function of mouse buttons */ #define KEY_DOBOX XK_R3 /* key to print image stats within box */ #else /* VMS */ #define KEY_ZOOM_IN XK_F2 /* key to zoom in */ #define KEY_ZOOM_0 XK_F3 /* go to normal size image */ #define KEY_ZOOM_OUT XK_F4 /* key to zoom out */ #define KEY_HELP XK_Help /* help button */ #define KEY_CUR_TOG XK_F6 /* key to toggle cursor output */ #define KEY_RECENTER XK_F7 /* to to recenter image */ #define KEY_LOC_TOG XK_F8 /* key to toggle the show location window */ #define KEY_QUIT XK_F9 /* key to quit */ #define KEY_CMAP XK_F10 /* key to toggle display of color map window */ #define KEY_PAT_TOG XK_L1 /* key to show/update/hide patch window */ #define KEY_ROW XK_L2 /* key to produce a row plot */ #define KEY_IMPS XK_L3 /* key to print the entire image on the */ /* PostScript printer PRINTER. */ #define KEY_WINPS XK_L4 /* key to print the visible portion of the */ /* image on the PostScript printer PRINTER. */ #define KEY_INVERT XK_L8 /* key to invert the color maps */ #define KEY_SEE_TOG XK_L9 /* key to show/update/hide the seeing window */ #define KEY_COL XK_L10 /* key to produce a column plot */ #define KEY_SLDEC XK_comma /* key to decrease slit width */ #define KEY_SLINC XK_period /* key to increase slit width */ #define KEY_SLRES XK_slash /* key to reset slit width */ #define KEY_INHIBIT XK_L6 /* inhibit other key interpretations */ #define KEY_HIST XK_R1 /* key to use histogram equalization */ #define KEY_MOUSEMODE XK_R2 /* key to change function of mouse buttons */ #define KEY_DOBOX XK_R3 /* key to print image stats within box */ #define KEY_ZOOMX_IN XK_R7 /* Zoom in X only */ #define KEY_ZOOMX_OUT XK_R9 /* Zoom in X only */ #define KEY_ZOOMY_IN XK_R13 /* Zoom in X only */ #define KEY_ZOOMY_OUT XK_R15 /* Zoom in X only */ #define KEY_LWRAP_INC XK_greater /* increase the LUT wrap */ #define KEY_LWRAP_DEC XK_less /* decrease the LUT wrap */ #define KEY_LWRAP_RES XK_question /* reset the LUT wrap */ #endif /* VMS */ #define DEFAULT_FONT "fixed" /* The options to look for */ static XrmOptionDescRec fdops[] = { {"-display", ".display", XrmoptionSepArg, (char *) NULL}, #ifdef PGDISP {"-geometry", ".lg.geometry", XrmoptionSepArg, (char *) NULL}, #else {"-geometry", ".bm.geometry", XrmoptionSepArg, (char *) NULL}, #endif {"-bmGeometry", ".bm.geometry", XrmoptionSepArg, (char *) NULL}, {"-lgGeometry", ".lg.geometry", XrmoptionSepArg, (char *) NULL}, {"-patchGeometry",".patchgeometry", XrmoptionSepArg, (char *) NULL}, {"-cmapGeometry",".cmapgeometry", XrmoptionSepArg, (char *) NULL}, {"-locationGeometry",".locationgeometry",XrmoptionSepArg, (char *) NULL}, {"-histogramGeometry", ".histgeometry", XrmoptionSepArg, (char *) NULL}, {"-colors", ".bm.maxcolors", XrmoptionSepArg, (char *) NULL}, {"-maxColors", ".bm.maxcolors", XrmoptionSepArg, (char *) NULL}, {"-minColors", ".bm.mincolors", XrmoptionSepArg, (char *) NULL}, {"-privateColors",".bm*private.maxcolors",XrmoptionSepArg, (char *) NULL}, {"-maxPrivateColors",".bm*private.maxcolors",XrmoptionSepArg, (char *) NULL}, {"-minPrivateColors",".bm*private.mincolors",XrmoptionSepArg, (char *) NULL}, {"-lineColors", ".lineColors", XrmoptionSepArg, (char *) NULL}, {"-help", ".showhelp", XrmoptionNoArg, (char *) "True"}, {"-nohelp", ".showhelp", XrmoptionNoArg, (char *) "False"}, {"-font", ".font", XrmoptionSepArg, (char *) NULL}, {"-fn", ".font", XrmoptionSepArg, (char *) NULL}, {"-psFile", ".psFile", XrmoptionSepArg, (char *) NULL}, {"-P", ".printer", XrmoptionSepArg, (char *) NULL}, {"-printer", ".printer", XrmoptionSepArg, (char *) NULL}, {"-sleepTime", ".sleepTime", XrmoptionSepArg, (char *) NULL}, {"-forceSquare", ".forceSquare", XrmoptionNoArg, (char *) "True"}, {"-noforceSquare", ".forceSquare", XrmoptionNoArg, (char *) "False"}, {"-saveColors", ".saveColors", XrmoptionSepArg, (char *) NULL}, {"-leaveColors",".leaveColors", XrmoptionSepArg, (char *) NULL}, {"-leftToRight", ".line.leftToRight", XrmoptionNoArg, (char *) "True"}, {"-noleftToRight", ".line.leftToRight", XrmoptionNoArg, (char *) "False"}, {"-ascendingCoord", ".line.ascending", XrmoptionNoArg, (char *) "True"}, {"-noascendingCoord", ".line.ascending", XrmoptionNoArg, (char *) "False"}, {"-plothist", ".line.histogram", XrmoptionNoArg, (char *) "True"}, {"-noplothist", ".line.histogram", XrmoptionNoArg, (char *) "False"}, {"-ascendingX", ".row.ascending", XrmoptionNoArg, (char *) "True"}, {"-noascendingX", ".row.ascending", XrmoptionNoArg, (char *) "False"}, {"-rowLeftToRight", ".row.leftToRight", XrmoptionNoArg, (char *) "True"}, {"-norowLeftToRight", ".row.leftToRight", XrmoptionNoArg, (char *) "False"}, {"-ascendingY", ".col.ascending", XrmoptionNoArg, (char *) "True"}, {"-noascendingY", ".col.ascending", XrmoptionNoArg, (char *) "False"}, {"-bottomToTop", ".col.bottomToTop", XrmoptionNoArg, (char *) "True"}, {"-nobottomToTop", ".col.bottomToTop", XrmoptionNoArg, (char *) "False"}, {"-id", ".id", XrmoptionSepArg, (char *) NULL}, {"-visual", ".visual", XrmoptionSepArg, (char *) NULL}, {"-lgCrosshair", ".lg.crosshair", XrmoptionNoArg, (char *) "True"}, {"-nolgCrosshair", ".lg.crosshair", XrmoptionNoArg, (char *) "False"}, {"-initLUTWrap", ".initLUTWrap", XrmoptionSepArg, (char *) NULL}, /* The key controls */ {"-zoomin", ".zoomIn", XrmoptionSepArg, (char *) NULL}, {"-zoomnorm", ".zoomNorm", XrmoptionSepArg, (char *) NULL}, {"-zoomout", ".zoomOut", XrmoptionSepArg, (char *) NULL}, {"-zoomxin", ".x.zoomIn", XrmoptionSepArg, (char *) NULL}, {"-zoomxout", ".x.zoomOut", XrmoptionSepArg, (char *) NULL}, {"-zoomyin", ".y.zoomIn", XrmoptionSepArg, (char *) NULL}, {"-zoomyout", ".y.zoomOut", XrmoptionSepArg, (char *) NULL}, {"-helpkey", ".help", XrmoptionSepArg, (char *) NULL}, {"-cursor", ".cursor", XrmoptionSepArg, (char *) NULL}, {"-recenter", ".recenter", XrmoptionSepArg, (char *) NULL}, {"-showloc", ".showLoc", XrmoptionSepArg, (char *) NULL}, {"-quit", ".quit", XrmoptionSepArg, (char *) NULL}, {"-showcmap", ".showCmap", XrmoptionSepArg, (char *) NULL}, {"-showpatch", ".showPatch", XrmoptionSepArg, (char *) NULL}, {"-row", ".row", XrmoptionSepArg, (char *) NULL}, {"-imagePrint", ".imagePs", XrmoptionSepArg, (char *) NULL}, {"-windowPrint", ".windowPs", XrmoptionSepArg, (char *) NULL}, {"-invert", ".invertCmap", XrmoptionSepArg, (char *) NULL}, {"-showsee", ".showSee", XrmoptionSepArg, (char *) NULL}, {"-column", ".column", XrmoptionSepArg, (char *) NULL}, {"-decreaseSlit", ".decreaseSlit", XrmoptionSepArg, (char *) NULL}, {"-increaseSlit", ".increaseSlit", XrmoptionSepArg, (char *) NULL}, {"-resetSlit", ".resetSlit", XrmoptionSepArg, (char *) NULL}, {"-inhibit", ".inhibit", XrmoptionSepArg, (char *) NULL}, {"-histogram", ".histogram", XrmoptionSepArg, (char *) NULL}, {"-increaseLUTWrap", ".increaseLUTWrap", XrmoptionSepArg, (char *) NULL}, {"-decreaseLUTWrap", ".decreaseLUTWrap", XrmoptionSepArg, (char *) NULL}, {"-resetLUTWrap", ".resetLUTWrap", XrmoptionSepArg, (char *) NULL}, {"-box", ".box", XrmoptionSepArg, (char *) NULL}, {"-mouseMode", ".mouseMode", XrmoptionSepArg, (char *) NULL}, /* the rest aren't yet implemented */ /* one each for patch, line graphics, and seeing windows */ /* only one */ {"-name", ".name", XrmoptionSepArg, (char *) NULL}, /* one for each window */ {"-borderwidth", "*borderWidth", XrmoptionSepArg, (char *) NULL}, {"-bw", "*borderWidth", XrmoptionSepArg, (char *) NULL}, {"-title", ".bm*title", XrmoptionSepArg, (char *) NULL}, {"-bordercolor", "*borderColor", XrmoptionSepArg, (char *) NULL}, {"-bc", "*borderColor", XrmoptionSepArg, (char *) NULL}, {"-icon", "*icon", XrmoptionSepArg, (char *) NULL}, {"-iconGeometry", ".bm*iconGeometry", XrmoptionSepArg, (char *) NULL}, {"-iconic", ".bm*iconic", XrmoptionNoArg, (char *) "on"}, /* one each for bitmap, line graphics, patch, and color map windows */ /* (the seeing window is fixed size, and the location window could be */ /* resized by the program) */ {"-minGeometry",".bm*minGeometry", XrmoptionSepArg, (char *) NULL}, {"-maxGeometry",".bm*maxGeometry", XrmoptionSepArg, (char *) NULL}, /* for line graphics only */ {"-blank", ".lg*blank", XrmoptionSepArg, (char *) NULL}, /* one each for patch and seeing windows */ {"-background", "*background", XrmoptionSepArg, (char *) NULL}, {"-bg", "*background", XrmoptionSepArg, (char *) NULL}, {"-foreground", "*foreground", XrmoptionSepArg, (char *) NULL}, {"-fg", "*foreground", XrmoptionSepArg, (char *) NULL}, }; /* The resource database */ static XrmDatabase resdb=NULL; /* The command line resource database */ static XrmDatabase comdb=NULL; /* The name of the program */ static char prog[80]; static char *GetHomeDir(); /* The parseops routine parses command line arguments */ void parsedisp(argc, argv) int *argc; char **argv; { /* the name of the display */ char dispname[256]; XrmValue value; char *strtype[20]; char *progname; void Usage(); dispname[0] = '\0'; if ((progname=strrchr(argv[0],'/')) == NULL) strcpy(prog,argv[0]); else strcpy(prog,progname+1); if (*argc != 1) XrmParseCommand(&comdb, fdops, sizeof(fdops)/sizeof(fdops[0]), prog, argc, argv); if (*argc != 1) Usage(argv[0]); /* get a display value so we can get other databases */ if (XrmGetResource(comdb, "figdisp.display", "Figdisp.Display", strtype, &value) == True) { (void)strncpy(dispname, value.addr, (int) value.size); } /* Open the specified display */ if (!(display=XOpenDisplay(dispname))) { (void)fprintf(stderr, "%s: Can't open display '%s'\n", argv[0], XDisplayName(dispname)); #ifndef lint exit(FAIL); #endif } return; } /* The mergeops routine merges the command line options in with all the */ /* resource files */ void mergeops() { XrmDatabase appdb,servdb,homedb; char filename[1024]; char *env; #ifdef PGDISP char *classname = "Pgdisp"; #else char *classname = "Figdisp"; #endif /* get the application defaults */ if ((env=getenv("XAPPLRESDIR")) == NULL) (void)strcpy(filename, "/usr/lib/X11/app-defaults/"); else (void)strcpy(filename, env); (void)strcat(filename, "/"); (void)strcat(filename, classname); appdb=XrmGetFileDatabase(filename); XrmMergeDatabases(appdb, &resdb); /* get the server defaults (or .Xdefaults) */ if (XResourceManagerString(display) != NULL) servdb=XrmGetStringDatabase(XResourceManagerString(display)); else { #ifdef VMS (void)strcat(filename,"SYS$LOGIN:.Xdefaults"); #else (void)GetHomeDir(filename); (void)strcat(filename,"/.Xdefaults"); #endif servdb=XrmGetFileDatabase(filename); } (void) XrmMergeDatabases(servdb, &resdb); /* get the XENVIRONMENT file or (if not defined) .Xdefaults for this */ /* host */ if ((env=getenv("XENVIRONMENT")) == NULL) { #ifndef VMS int len; env=GetHomeDir(filename); len=strlen(env); #ifdef solaris sysinfo (SI_HOSTNAME, env+len, 1024 - len); #else (void)gethostname(env+len,1024-len); #endif #endif } if (env != NULL) { homedb=XrmGetFileDatabase(env); (void) XrmMergeDatabases(homedb, &resdb); } /* merge in the command line */ (void) XrmMergeDatabases(comdb, &resdb); return; } /* The extractops routine extracts the options into a form the program can */ /* use. */ void extractops() { char *strtype[20]; XrmValue value; int flags; char resource[80]; (void)sprintf(resource, "%s.bm.geometry", prog); if (XrmGetResource(resdb, resource, "*Geometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.bmgeo.x, &res.bmgeo.y, (unsigned int *)&res.bmgeo.w, (unsigned int *)&res.bmgeo.h); if (!(flags & WidthValue)) res.bmgeo.w=BM_WIDTH; if (!(flags & HeightValue)) res.bmgeo.h=BM_HEIGHT; if (!(flags & XValue)) res.bmgeo.x= -1; if (!(flags & YValue)) res.bmgeo.y= -1; if ((flags & XValue) && (flags & XNegative)) res.bmgeo.x += (DisplayWidth(display,screen) - res.bmgeo.w); if ((flags & YValue) && (flags & YNegative)) res.bmgeo.y += (DisplayHeight(display,screen) - res.bmgeo.h); } else { res.bmgeo.w=BM_WIDTH; res.bmgeo.h=BM_HEIGHT; res.bmgeo.x=res.lggeo.y= -1; } (void)sprintf(resource, "%s.lg.geometry", prog); if (XrmGetResource(resdb, resource, "*Geometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.lggeo.x, &res.lggeo.y, (unsigned int *)&res.lggeo.w, (unsigned int *)&res.lggeo.h); if (!(flags & WidthValue)) res.lggeo.w=BM_WIDTH; if (!(flags & HeightValue)) res.lggeo.h=BM_HEIGHT; if (!(flags & XValue)) res.lggeo.x= -1; if (!(flags & YValue)) res.lggeo.y= -1; if ((flags & XValue) && (flags & XNegative)) res.lggeo.x += (DisplayWidth(display,screen) - res.lggeo.w); if ((flags & YValue) && (flags & YNegative)) res.lggeo.y += (DisplayHeight(display,screen) - res.lggeo.h); } else { res.lggeo.w=LG_WIDTH; res.lggeo.h=LG_HEIGHT; res.lggeo.x=res.lggeo.y= -1; } (void)sprintf(resource, "%s.showhelp", prog); if (XrmGetResource(resdb, resource, "*Showhelp", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.showhelp=0; else res.showhelp=1; } else res.showhelp=1; /* see if we should use the line graphics crosshair cursor */ (void)sprintf(resource, "%s.lg.crosshair", prog); if (XrmGetResource(resdb, resource, "*Crosshair", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.lgcross=0; else res.lgcross=1; } else res.lgcross=0; /* Get the default dimensions for the patch window */ (void)sprintf(resource, "%s.patchgeometry", prog); if (XrmGetResource(resdb, resource, "*Patchgeometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.pgeo.x, &res.pgeo.y, (unsigned int *)&res.pgeo.w, (unsigned int *)&res.pgeo.h); if (!(flags & WidthValue)) res.pgeo.w=BM_WIDTH; if (!(flags & HeightValue)) res.pgeo.h=BM_HEIGHT; if (!(flags & XValue)) res.pgeo.x= -1; if (!(flags & YValue)) res.pgeo.y= -1; if ((flags & XValue) && (flags & XNegative)) res.pgeo.x += (DisplayWidth(display,screen) - res.pgeo.w); if ((flags & YValue) && (flags & YNegative)) res.pgeo.y += (DisplayHeight(display,screen) - res.pgeo.h); } else res.pgeo.w=res.pgeo.h=res.pgeo.x=res.pgeo.y= -1; /* Get the default dimensions for the color map window */ (void)sprintf(resource, "%s.cmapgeometry", prog); if (XrmGetResource(resdb, resource, "Cmapgeometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.cgeo.x, &res.cgeo.y, (unsigned int *)&res.cgeo.w, (unsigned int *)&res.cgeo.h); if (!(flags & WidthValue)) res.cgeo.w=CM_WIDTH; if (!(flags & HeightValue)) res.cgeo.h=CM_HEIGHT; if (!(flags & XValue)) res.cgeo.x= -1; if (!(flags & YValue)) res.cgeo.y= -1; if ((flags & XValue) && (flags & XNegative)) res.cgeo.x += (DisplayWidth(display,screen) - res.cgeo.w); if ((flags & YValue) && (flags & YNegative)) res.cgeo.y += (DisplayHeight(display,screen) - res.cgeo.h); } else { res.cgeo.x=res.cgeo.y= -1; res.cgeo.w=CM_WIDTH; res.cgeo.h=CM_HEIGHT; } /* Get the default dimensions for the location window */ (void)sprintf(resource, "%s.locationgeometry", prog); if (XrmGetResource(resdb, resource, "*Locationgeometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.lgeo.x, &res.lgeo.y, (unsigned int *)&res.lgeo.w, (unsigned int *)&res.lgeo.h); if (!(flags & WidthValue)) res.lgeo.w=LOC_WIDTH; if (!(flags & HeightValue)) res.lgeo.h=LOC_HEIGHT; if (!(flags & XValue)) res.lgeo.x= -1; if (!(flags & YValue)) res.lgeo.y= -1; if ((flags & XValue) && (flags & XNegative)) res.lgeo.x += (DisplayWidth(display,screen) - res.lgeo.w); if ((flags & YValue) && (flags & YNegative)) res.lgeo.y += (DisplayHeight(display,screen) - res.lgeo.h); } else { res.lgeo.x=res.lgeo.y= -1; res.lgeo.w=LOC_WIDTH; res.lgeo.h=LOC_HEIGHT; } /* Get the area to be used for histogram equalization */ (void)sprintf(resource, "%s.histgeometry", prog); if (XrmGetResource(resdb, resource, "*histgeometry", strtype, &value) == True) { flags = XParseGeometry(value.addr, &res.histgeo.x, &res.histgeo.y, (unsigned int *)&res.histgeo.w, (unsigned int *)&res.histgeo.h); if (!(flags & WidthValue)) res.histgeo.w=HIST_WIDTH; if (!(flags & HeightValue)) res.histgeo.h=HIST_HEIGHT; } else { res.histgeo.w=HIST_WIDTH; res.histgeo.h=HIST_HEIGHT; } /* now get the maximum colors to use in the default cmap */ (void)sprintf(resource, "%s.bm.maxcolors", prog); if (XrmGetResource(resdb, resource, "*Maxcolors", strtype, &value) == True) { if ((res.maxcolors=atoi(value.addr)) > BM_COLORS) { (void)fprintf(stderr, "Maxcolors reduced to maximum of %d\n", BM_COLORS); res.maxcolors=BM_COLORS; } else if (res.maxcolors < 0) { (void)fprintf(stderr, "Maxcolors changed from %d to %d\n", res.maxcolors, BM_MAX_SH_COLS), res.maxcolors=BM_MAX_SH_COLS; } } else res.maxcolors=BM_MAX_SH_COLS; /* now get the minimum colors to use in the default cmap */ (void)sprintf(resource, "%s.bm.mincolors", prog); if (XrmGetResource(resdb, resource, "*Mincolors", strtype, &value) == True) { if ((res.mincolors=atoi(value.addr)) > BM_COLORS) { (void)fprintf(stderr, "Mincolors reduced to maximum of %d\n", BM_COLORS); res.mincolors=BM_COLORS; } else if (res.mincolors < 0) { (void)fprintf(stderr, "Mincolors changed from %d to %d\n", res.mincolors, BM_MIN_SH_COLS), res.mincolors=BM_MIN_SH_COLS; } } else res.mincolors=BM_MIN_SH_COLS; /* now get the maximum colors to use in a private cmap */ (void)sprintf(resource, "%s.bm.private.maxcolors", prog); if (XrmGetResource(resdb, resource, "*Private*Maxcolors", strtype, &value) == True) { if ((res.maxpcolors=atoi(value.addr)) > BM_COLORS) { (void)fprintf(stderr, "Maxpcolors reduced to maximum of %d\n", BM_COLORS); res.maxpcolors=BM_COLORS; } else if (res.maxpcolors < 0) { (void)fprintf(stderr, "Maxpcolors changed from %d to %d\n", res.maxpcolors, BM_COLORS), res.maxpcolors=BM_COLORS; } } else res.maxpcolors=BM_COLORS; /* now get the minimum colors to use in a private cmap */ (void)sprintf(resource, "%s.bm.private.mincolors", prog); if (XrmGetResource(resdb, resource, "*Private*Mincolors", strtype, &value) == True) { if ((res.minpcolors=atoi(value.addr)) > BM_COLORS) { (void)fprintf(stderr, "Minpcolors reduced to maximum of %d\n", BM_COLORS); res.minpcolors=BM_COLORS; } else if (res.minpcolors < 0) { (void)fprintf(stderr, "Minpcolors changed from %d to %d\n", res.minpcolors, BM_MIN_COLORS), res.minpcolors=BM_MIN_COLORS; } } else res.minpcolors=BM_MIN_COLORS; /* Now get the number of colors to use for the line graphics window. */ /* See the routine getvisuals() for information on how this is done. */ (void)sprintf(resource, "%s.lineColors", prog); if (XrmGetResource(resdb, resource, "*LineColors", strtype, &value) == True) { if ((res.lgcolors=atoi(value.addr)) < 2) { (void)fprintf(stderr, "LineColors increased to minimum of %d\n", LG_MIN_COLORS); res.lgcolors=LG_MIN_COLORS; } } else res.lgcolors=LG_COLORS; /* Now get the number of times to wrap the LUT initially */ (void)sprintf(resource, "%s.initLUTWrap", prog); if (XrmGetResource(resdb, resource, "*InitLUTWrap", strtype, &value) == True) { if ((res.initwrap=atoi(value.addr)) < 1) { (void)fprintf(stderr, "InitLUTWRap increased to minimum of 1\n"); res.initwrap=1; } } else res.initwrap=INIT_LUT_WRAP; /* now get the key for zooming in */ (void)sprintf(resource, "%s.zoomIn", prog); if (XrmGetResource(resdb, resource, "*ZoomIn", strtype, &value) == True) res.keys[ZOOMIN]=XStringToKeysym(value.addr); else res.keys[ZOOMIN]=KEY_ZOOM_IN; /* now get the key for resetting zoom factor */ (void)sprintf(resource, "%s.zoomNorm", prog); if (XrmGetResource(resdb, resource, "*ZoomNorm", strtype, &value) == True) res.keys[ZOOMNORM]=XStringToKeysym(value.addr); else res.keys[ZOOMNORM]=KEY_ZOOM_0; /* now get the key for zooming out */ (void)sprintf(resource, "%s.zoomOut", prog); if (XrmGetResource(resdb, resource, "*ZoomOut", strtype, &value) == True) res.keys[ZOOMOUT]=XStringToKeysym(value.addr); else res.keys[ZOOMOUT]=KEY_ZOOM_OUT; /* now get the key for zooming X in */ (void)sprintf(resource, "%s.x.zoomIn", prog); if (XrmGetResource(resdb, resource, "*X*ZoomIn", strtype, &value) == True) res.keys[ZOOMXIN]=XStringToKeysym(value.addr); else res.keys[ZOOMXIN]=KEY_ZOOMX_IN; /* now get the key for zooming X out */ (void)sprintf(resource, "%s.x.zoomOut", prog); if (XrmGetResource(resdb, resource, "*X*ZoomOut", strtype, &value) == True) res.keys[ZOOMXOUT]=XStringToKeysym(value.addr); else res.keys[ZOOMXOUT]=KEY_ZOOMX_OUT; /* now get the key for zooming Y in */ (void)sprintf(resource, "%s.y.zoomIn", prog); if (XrmGetResource(resdb, resource, "*Y*ZoomIn", strtype, &value) == True) res.keys[ZOOMYIN]=XStringToKeysym(value.addr); else res.keys[ZOOMYIN]=KEY_ZOOMY_IN; /* now get the key for zooming Y out */ (void)sprintf(resource, "%s.y.zoomOut", prog); if (XrmGetResource(resdb, resource, "*Y*ZoomOut", strtype, &value) == True) res.keys[ZOOMYOUT]=XStringToKeysym(value.addr); else res.keys[ZOOMYOUT]=KEY_ZOOMY_OUT; /* now get the key for printhing help */ (void)sprintf(resource, "%s.help", prog); if (XrmGetResource(resdb, resource, "*Help", strtype, &value) == True) res.keys[HELP]=XStringToKeysym(value.addr); else res.keys[HELP]=KEY_HELP; /* now get the key for toggling cursor output */ (void)sprintf(resource, "%s.cursor", prog); if (XrmGetResource(resdb, resource, "*Cursor", strtype, &value) == True) res.keys[CURSOR]=XStringToKeysym(value.addr); else res.keys[CURSOR]=KEY_CUR_TOG; /* now get the key for recentering the image */ (void)sprintf(resource, "%s.recenter", prog); if (XrmGetResource(resdb, resource, "*Recenter", strtype, &value) == True) res.keys[RECENTER]=XStringToKeysym(value.addr); else res.keys[RECENTER]=KEY_RECENTER; /* now get the key for toggling the location window */ (void)sprintf(resource, "%s.showLoc", prog); if (XrmGetResource(resdb, resource, "*ShowLoc", strtype, &value) == True) res.keys[SHOWLOC]=XStringToKeysym(value.addr); else res.keys[SHOWLOC]=KEY_LOC_TOG; /* now get the key for quitting */ (void)sprintf(resource, "%s.quit", prog); if (XrmGetResource(resdb, resource, "*Quit", strtype, &value) == True) res.keys[QUIT]=XStringToKeysym(value.addr); else res.keys[QUIT]=KEY_QUIT; /* now get the key for toggline the color map window */ (void)sprintf(resource, "%s.showCmap", prog); if (XrmGetResource(resdb, resource, "*ShowCmap", strtype, &value) == True) res.keys[SHOWCM]=XStringToKeysym(value.addr); else res.keys[SHOWCM]=KEY_CMAP; /* now get the key for showing the patch window */ (void)sprintf(resource, "%s.showPatch", prog); if (XrmGetResource(resdb, resource, "*ShowPatch", strtype, &value) == True) res.keys[SHOWPAT]=XStringToKeysym(value.addr); else res.keys[SHOWPAT]=KEY_PAT_TOG; /* now get the key for producing a row plot */ (void)sprintf(resource, "%s.row", prog); if (XrmGetResource(resdb, resource, "*Row", strtype, &value) == True) res.keys[ROW]=XStringToKeysym(value.addr); else res.keys[ROW]=KEY_ROW; /* now get the key for printing the entire image */ (void)sprintf(resource, "%s.imagePs", prog); if (XrmGetResource(resdb, resource, "*ImagePS", strtype, &value) == True) res.keys[IMPS]=XStringToKeysym(value.addr); else res.keys[IMPS]=KEY_IMPS; /* now get the key for printing the window */ (void)sprintf(resource, "%s.windowPs", prog); if (XrmGetResource(resdb, resource, "*WindowPS", strtype, &value) == True) res.keys[WINPS]=XStringToKeysym(value.addr); else res.keys[WINPS]=KEY_WINPS; /* now get the key for inverting the color map */ (void)sprintf(resource, "%s.invertCmap", prog); if (XrmGetResource(resdb, resource, "*InvertCmap", strtype, &value) == True) res.keys[INVERT]=XStringToKeysym(value.addr); else res.keys[INVERT]=KEY_INVERT; /* now get the key for calculating the seeing */ (void)sprintf(resource, "%s.showSee", prog); if (XrmGetResource(resdb, resource, "*ShowSee", strtype, &value) == True) res.keys[SEEING]=XStringToKeysym(value.addr); else res.keys[SEEING]=KEY_SEE_TOG; /* now get the key for producing a column plot */ (void)sprintf(resource, "%s.column", prog); if (XrmGetResource(resdb, resource, "*Column", strtype, &value) == True) res.keys[COL]=XStringToKeysym(value.addr); else res.keys[COL]=KEY_COL; /* now get the key for decreasing the slit width */ (void)sprintf(resource, "%s.decreaseSlit", prog); if (XrmGetResource(resdb, resource, "*DecreaseSlit", strtype, &value) == True) res.keys[DECSLIT]= XStringToKeysym(value.addr); else res.keys[DECSLIT]=KEY_SLDEC; /* now get the key for increasing the slit width */ (void)sprintf(resource, "%s.increaseSlit", prog); if (XrmGetResource(resdb, resource, "*IncreaseSlit", strtype, &value) == True) res.keys[INCSLIT]=XStringToKeysym(value.addr); else res.keys[INCSLIT]=KEY_SLINC; /* now get the key for resetting the slit width */ (void)sprintf(resource, "%s.resetSlit", prog); if (XrmGetResource(resdb, resource, "*ResetSlit", strtype, &value) == True) res.keys[RESSLIT]=XStringToKeysym(value.addr); else res.keys[RESSLIT]=KEY_SLRES; /* get the key for inhibiting other key interpretations */ (void)sprintf(resource, "%s.inhibit", prog); if (XrmGetResource(resdb, resource, "*Inhibit", strtype, &value) == True) res.keys[INHIBIT]=XStringToKeysym(value.addr); else res.keys[INHIBIT]=KEY_INHIBIT; /* now get the key to toggle use of histogram equalization */ (void)sprintf(resource, "%s.histogram", prog); if (XrmGetResource(resdb, resource, "*Histogram", strtype, &value) == True) res.keys[HISTOGRAM]=XStringToKeysym(value.addr); else res.keys[HISTOGRAM]=KEY_HIST; /* now the key for increasing the LUT wrap */ (void)sprintf(resource, "%s.increaseLUTWrap", prog); if (XrmGetResource(resdb, resource, "*.increaseLUTWrap",strtype,&value) == True) res.keys[INCLUTWRAP]=XStringToKeysym(value.addr); else res.keys[INCLUTWRAP]=KEY_LWRAP_INC; /* now the key for decreasing the LUT wrap */ (void)sprintf(resource, "%s.decreaseLUTWrap", prog); if (XrmGetResource(resdb, resource, "*.decreaseLUTWrap",strtype,&value) == True) res.keys[DECLUTWRAP]=XStringToKeysym(value.addr); else res.keys[DECLUTWRAP]=KEY_LWRAP_DEC; /* now the key for resetting the LUT wrap */ (void)sprintf(resource, "%s.resetLUTWrap", prog); if (XrmGetResource(resdb, resource, "*.ResetLUTWrap",strtype,&value) == True) res.keys[RESLUTWRAP]=XStringToKeysym(value.addr); else res.keys[RESLUTWRAP]=KEY_LWRAP_RES; /* now get the key to toggle the mouse mode */ (void)sprintf(resource, "%s.mouseMode", prog); if (XrmGetResource(resdb, resource, "*MouseMode", strtype, &value) == True) res.keys[MOUSEMODE]=XStringToKeysym(value.addr); else res.keys[MOUSEMODE]=KEY_MOUSEMODE; /* now get the key to get image stats within box */ (void)sprintf(resource, "%s.box", prog); if (XrmGetResource(resdb, resource, "*Box", strtype, &value) == True) res.keys[DOBOX]=XStringToKeysym(value.addr); else res.keys[DOBOX]=KEY_DOBOX; /* Get the font to use */ res.textfont=NULL; (void)sprintf(resource, "%s.font", prog); if (XrmGetResource(resdb, resource, "*Font", strtype, &value) == True) { if ((res.textfont=XLoadQueryFont(display, value.addr)) == NULL) (void)fprintf(stderr, "Font %s not found, using default of %s\n", value.addr, DEFAULT_FONT); } if (res.textfont == NULL) res.textfont=XLoadQueryFont(display, DEFAULT_FONT); /* Get the PostScript output file (if any) */ res.psfile=NULL; (void)sprintf(resource, "%s.psFile", prog); if (XrmGetResource(resdb, resource, "*PsFile", strtype, &value) == True) { if ((res.psfile=malloc(value.size)) == NULL) { (void)fprintf(stderr, "Could not get memory for output file name.\n"); (void)fprintf(stderr, "Output will be sent to the printer.\n"); } else if (!strncmp(value.addr,"direct", sizeof("direct"))) { /* we want output to be direct to the printer */ free(res.psfile); res.psfile=NULL; } else (void)strncpy(res.psfile, value.addr, (int)value.size); } /* get the printer to use for output */ res.printer=NULL; (void)sprintf(resource, "%s.printer", prog); if (XrmGetResource(resdb, resource, "*Printer", strtype, &value) == True) { if ((res.printer=malloc(value.size)) == NULL) { (void)fprintf(stderr, "Could not get memory for printer name.\n"); } else if (!strncmp(value.addr,"PRINTER", sizeof("PRINTER"))) { /* go to the default (PRINTER environment var) */ free(res.printer); res.printer=NULL; } else (void)strncpy(res.printer, value.addr, (int)value.size); } /* Get the id for this copy of the display */ (void)sprintf(resource, "%s.id", prog); if (XrmGetResource(resdb, resource, "*Id", strtype, &value) == True) res.id=atoi(value.addr); else res.id=0; /* Get the visual class to use for line graphics */ (void)sprintf(resource, "%s.visual", prog); res.visclass=AnyVis; if (XrmGetResource(resdb, resource, "*Visual", strtype, &value) == True) { if (!strncmp(value.addr, "GrayScale", sizeof("GrayScale"))) res.visclass=GrayScale; else if (!strncmp(value.addr, "PseudoColor", sizeof("PseudoColor"))) res.visclass=PseudoColor; #ifdef PGDISP else if (!strncmp(value.addr, "DirectColor", sizeof("DirectColor"))) res.visclass=DirectColor; else if (!strncmp(value.addr, "StaticGray", sizeof("StaticGray"))) res.visclass=StaticGray; else if (!strncmp(value.addr, "StaticColor", sizeof("StaticColor"))) res.visclass=StaticColor; else if (!strncmp(value.addr, "TrueColor", sizeof("TrueColor"))) res.visclass=TrueColor; #endif else if (!strncmp(value.addr, "Any", sizeof("Any"))) res.visclass=AnyVis; else if (!strncmp(value.addr, "Default", sizeof("Default"))) res.visclass=DefaultVis; else { (void)fprintf(stderr, "Invalid visual %s specified.\n", value.addr); (void)fprintf(stderr,"Using default of Any\n"); } } /* now get the number of microseconds to sleep between checks for */ /* the existance of a client program. See waitevent.c for more */ /* details. */ (void)sprintf(resource, "%s.sleepTime", prog); if (XrmGetResource(resdb, resource, "*SleepTime", strtype, &value) == True) { if ((res.sleeptime=atoi(value.addr)) < MIN_USLEEP_TIME) { res.sleeptime=MIN_USLEEP_TIME; (void)fprintf(stderr, "SleepTime increased to minimumm of %d\n", MIN_USLEEP_TIME); } } else res.sleeptime=USLEEP_TIME; /* see if we should force the location window pixels to be square. */ res.forcesquare=0; (void)sprintf(resource, "%s.forceSquare", prog); if (XrmGetResource(resdb, resource, "*ForceSquare", strtype, &value) == True) { if (strncmp(value.addr, "True", (int)value.size) == 0) res.forcesquare=1; } /* now get the number of colors to copy from the default colormap to */ /* a private color map. This is so things like title bars will be */ /* the same between both color maps. */ (void)sprintf(resource, "%s.saveColors", prog); if (XrmGetResource(resdb, resource,"*SaveColors", strtype, &value) == True) { if ((res.savecolors=atoi(value.addr)) < 0) res.savecolors=0; } else res.savecolors=SAVE_COLORS; /* now get the number of colors to leave available in the default */ /* colormap. This is so applications started after figdisp will */ /* be able to use the default colormap. */ (void)sprintf(resource, "%s.leaveColors", prog); if (XrmGetResource(resdb, resource, "*LeaveColors", strtype, &value) == True) { if ((res.leavecolors=atoi(value.addr)) < 0) res.leavecolors=0; } else res.leavecolors=LEAVE_COLORS; /* does the user want the line plots to always go from left to right? */ res.lefttoright=0; (void)sprintf(resource, "%s.line.leftToRight", prog); if (XrmGetResource(resdb, resource, "*LeftToRight", strtype, &value) == True) { if (strncmp(value.addr, "True", (int)value.size) == 0) res.lefttoright=1; } /* Does the user want the line plots to always increase with the */ /* appropriate coordinate? */ res.ascendcoord=0; (void)sprintf(resource, "%s.line.ascending", prog); if (XrmGetResource(resdb, resource, "*Ascending", strtype, &value) == True) { if (strncmp(value.addr, "True", (int)value.size) == 0) res.ascendcoord=1; } /* Does the use want line plots to be in histogram form? */ res.plothist=0; (void)sprintf(resource, "%s.line.histogram", prog); if (XrmGetResource(resdb, resource, "*Line*Histogram", strtype, &value) == True) { if (strncmp(value.addr, "True", (int)value.size) == 0) res.plothist=1; } /* Does the user want column plots to always go bottom to top? */ res.bottotop=1; (void)sprintf(resource, "%s.col.bottomToTop", prog); if (XrmGetResource(resdb, resource, "*Col*BottomToTop", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.bottotop=0; } /* Does the user want column plots to always follow ascending y? */ res.ascendy=1; (void)sprintf(resource, "%s.col.ascending", prog); if (XrmGetResource(resdb, resource, "*Ascending", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.ascendy=0; } /* Does the user want row plots to always go left to right? */ res.rowltor=1; (void)sprintf(resource, "%s.row.leftToRight", prog); if (XrmGetResource(resdb, resource, "*LeftToRight", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.rowltor=0; } /* Does the user want row plots to always follow ascending x? */ res.ascendx=1; (void)sprintf(resource, "%s.row.ascending", prog); if (XrmGetResource(resdb, resource, "*Ascending", strtype, &value) == True) { if (strncmp(value.addr, "False", (int)value.size) == 0) res.ascendx=0; } return; } static char *usemsg[]={ "[-display DISP] [-geometry WxH[+x+y]] [-bmGeometry WxH[+x+y]]\n", "\t[-lgGeometry WxH[+x+y]] [-patchGeometry WxH[+x+y]]\n", "\t[-cmapGeometry WxH[+x+y]] [-locationGeometry WxH[+x+y]] [-colors #]\n", "\t[-maxColors #] [-minColors #] [-privateColors #] [-maxPrivateColors #]\n", "\t[-minPrivateColors #] [-help] [-nohelp] [-zoomin key] [-zoomnorm key]\n", "\t[-zoomout key] [-helpkey key] [-cursor key] [-recenter key]\n", "\t[-showloc key] [-quit key] [-showcmap key] [-showpatch key] [-row key]\n", "\t[-imagePrint key] [-windowPrint key] [-invert key] [-showsee key]\n", "\t[-column key] [-decreaseSlit key] [-increaseSlit key] [-resetSlit key]\n", "\t[-zoomxin key] [-zoomxout key] [-zoomyin key] [-zoomyout key]\n", "\t[-inhibit key] [-font font] [-fn font] [-P printer] [-printer printer]\n", "\t[-psFile output.ps] [-sleepTime usecs] [-forceSquare] [-noforceSquare]\n", "\t[-saveColors #] [-leftToRight] [-noleftToRight] [-ascendingX]\n", "\t[-noascendingX] [-rowLeftToRight] [-norowLeftToRight] [-ascendingY]\n", "\t[-noascendingY] [-bottomToTop] [-nobottomToTop] [-leaveColors #]\n", "\t[-ascendingCoord] [-noascendingCoord] [-id #] [-lineColors #]\n", "\t[-visual Vis] [-lgCrosshair] [-nolgCrosshair] [-histogram key]\n", "\t[-histogramGeometry WxH] [-plothist] [-noplothist] [-initLUTWrap #]\n", "\t[-increaseLUTWrap key] [-decreaseLUTWrap key] [-box key] [-mouseMode key]\n", "", }; void Usage(prog) char *prog; { int i=0; (void)printf("Usage:\n%s ",prog); while(*usemsg[i] != '\0') (void)printf("%s",usemsg[i++]); return; } #ifndef VMS /* striaght from the X manual */ static char *GetHomeDir(dest) char *dest; { int uid; extern char *getenv(); extern int getuid(); extern struct passwd *getpwuid(); struct passwd *pw; register char *ptr; if ((ptr = getenv("HOME")) != NULL) { (void)strcpy(dest, ptr); } else { if ((ptr = getenv("USER")) != NULL) { pw = getpwnam(ptr); } else { uid = getuid(); pw = getpwuid(uid); } if (pw) { (void)strcpy(dest, pw->pw_dir); } else { *dest = ' '; } } return dest; } #endif ysym(value.addr); else res.keys[HISTOGRAM]=KEY_HIST; /* now the key for increasing the LUT wrap */ (void)sprintf(resource, "%s.increaseLUTWrap", prog); if (XrmGetResource(resdb, resource, "*pgplot/pgdispd/getdata.c010064400040640000322000000067260554662565300157740ustar00tjpcitmbr00000400000017/* The getdata routine handles the aquisition of data from the user program. */ /* It is called upon receipt of a SelectionNotify event. */ /* Return Value: */ /* 1 If everything went fine */ /* 0 If something happened and the program should terminate. * /* Sam Southard, Jr. */ /* Created: 15-Dec-1990 from mainloop.c */ /* 18-Dec-1990 SNS/CIT Cursor information now in wininfo structure. */ /* 2-Apr-1991 SNS/CIT Image capabilities commented out for inclusion in */ /* xvideo program. */ /* 11-Apr-1991 SNS/CIT Modified to update the display if necessary. */ /* 10-May-1991 SNS/CIT Modified to be shared between Xvideo and pgdisp */ /* 15-Aug-1991 SNS/CIT No longer includes vista hooks */ /* 20-Aug-1991 SNS/CIT Now calculates buflen based on XMaxRequestSize */ /* instead of being hard coded. */ /* 5-Sep-1991 SNS/CIT Modified to lint cleanly */ /* 8-Oct-1991 SNS/CIT Globals moved to globals.h */ /* 19-Oct-1991 SNS/CIT No longer mistakenly resets buflen. */ /* 14-Apr-1992 SNS/CIT Now compiles under VMS */ /* 27-Sep-1992 SNS/CIT return buffer now stored in network byte order */ /* The system include files */ #include #include #include /* The X include files */ #include #include /* The program include files */ #include "commands.h" #include "figdisp.h" #include "globals.h" #include "messages.h" int getdata(event,rbuf,rbuflen,srcwin,selset) XSelectionEvent event; /* the event we're handling */ short *rbuf; /* a return buffer, if needed */ int *rbuflen; /* the length of the return buffer. If it's 0, no return */ /* message should be sent. */ Window srcwin; /* the source of our data */ int *selset; /* whether or not the selection is owned by a user program */ { short *buffer; /* buffer for the data received */ /* the max buffer length (in 16-bit words) */ static long buflen= -1; unsigned long nitems; /* the actual number of items we got */ unsigned long bytesleft; /* bytes left in the selection */ Atom acttype; /* the actual data type */ int actform; /* the actual data format */ void returnbuf(); /* return data to the user process */ void clearcurs(); /* clear the list of cursor presses */ int proccom (); if (buflen == -1) buflen= (XMaxRequestSize(display)-10)<<1; if (XGetWindowProperty(display, srcwin, event.property, 0L, buflen, True, AnyPropertyType, &acttype, &actform, &nitems, &bytesleft, (unsigned char **)&buffer) != Success) { (void)fprintf(stderr,MSG_BADGETPROP); return(0); } if (acttype == XA_STRING) { if (proccom(buffer,(int)nitems>>1,rbuf,rbuflen)) return(0); } else if (acttype == incrtype) { if (!nitems) { /* all done, get the selection back */ XSetSelectionOwner(display,selatom,lg.win,CurrentTime); if (XGetSelectionOwner(display,selatom) != lg.win) { (void)fprintf(stderr, MSG_BADSELOWN); return(0); } *selset=0; clearcurs(); XUngrabKeyboard(display,CurrentTime); #ifndef PGDISP (void)writeimage((short **)NULL,(int *)NULL); #endif (void)proccom(buffer,0,rbuf,rbuflen); if (*rbuflen) (void)fprintf(stderr,MSG_REPLYNOTSENT); *rbuflen=0; XFlush(display); } } else (void)fprintf(stderr,MSG_BADDATATYPE); XFree((char *)buffer); /* if no info to send, just go to next event */ if (!*rbuflen) return(1); /* send requested information back to client */ if (ntohs(*rbuf) != LG_CURS && ntohs(*rbuf) != BM_GET_CURS) { /* cursor information isn't here yet */ returnbuf(rbuf,*rbuflen,srcwin); *rbuflen=0; } return(1); } pgplot/sys_osf1/grgmem.c010064400040640000322000000020240603003060100157040ustar00tjpcitmbr00000400000017#include #include /* Fortran callable memory allocator Called as : ier = grgmem (size,pointer) where : size is an integer size of memory to allocate pointer is an integer to return the pointer into */ #ifdef PG_PPU #define GRGMEM grgmem_ #define GRFMEM grfmem_ #else #define GRGMEM grgmem #define GRFMEM grfmem #endif int GRGMEM(size, pointer) int *size; #if 0 int *pointer; #else char **pointer; #endif { #if 0 char *area = malloc(*size); *pointer = (int)area; if (area == NULL) return 0; return 1; #else if (!(*pointer=malloc(*size))) return 0; else return 1; #endif } /* Fortran callable memory deallocator Called as : ier = grfmem (size,pointer) where : size is an integer size of memory to deallocate (not used) pointer is an integer that contains the pointer */ int GRFMEM(size, pointer) int *size; #if 0 int *pointer; #else char **pointer; #endif { #if 0 char *area = (char *)*pointer; free(area); return 1; #else free(*pointer); return 1; #endif } pgplot/sys_osf1/f77_cc.conf010064400040640000322000000100740670202436100162210ustar00tjpcitmbr00000400000017# Digital UNIX [OSF/1]: the f77 FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-assume backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-Dmain=MAIN__" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl and # possibly add -ldl TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_osf1/f77_cc_shared.conf010064400040640000322000000102240670202441000175370ustar00tjpcitmbr00000400000017# Digital UNIX [OSF/1]: f77 FORTRAN and cc C compilers, with shared library #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-assume backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-Dmain=MAIN__" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -shared -all -o $SHARED_LIB -set_version 1.5 -nocount -lUfor -lfor -lFutil -lm -lots -lc" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_osf1/aaaread.me010064400040640000322000000071200670202431000161730ustar00tjpcitmbr00000400000017pgplot/sys_osf1 This directory is for Digital UNIX (formerly known as OSF/1) version of PGPLOT. The file f77_cc.conf for use with the makemake procedure is based on information received from Magnus Harlander (harlan@Physik.TU-Muenchen.DE) and Jean-Louis Oneto (OCA-CERGA, Grasse, France; oneto@ocar01.obs-azur.fr), but may require modification. The file f77_cc_shared.conf includes instructions for building a shared library, based on information received from Robin Williams (rjrw@ast.man.ac.uk). This doesn't work for everyone, so perhaps it needs to be modified for different versions of Digital UNIX. Please let me know if you have corrections. You may need to edit these files, especially the entries MOTIF_LIBS and TK_LINS if you use the Motif or Tk widget drivers. 64-BIT ADDRESSES Some of the PGPLOT device drivers use dynamic memory allocation and the non-standard %VAL() mechanism for passing the address of the dynamically allocated memory to a subroutine. This assumes that an address can be stored in an INTEGER variable, which is not true for this operating system. To use these drivers, you must edit the source code to change the data type for address variables from INTEGER to INTEGER*8. Comments in gidriv.f, ppdriv.f, wddriv.f indicate which variables must be changed. I hope to devise a more portable way of handling this problem in a future version of PGPLOT. OPERATING SYSTEM BUG Some users have reported the following problem: > f77 -assume backslash -o pgdemo1 /usrdevel/osf1/huangch/OSF1_working/pgplot/ > examples/pgdemo1.f -L`pwd` -lpgplot -lX11 > > Assertion failed: 0, file ../../../../../../src/usr/ccs/lib/libmld/cmrlc_pr > oduce.c, line 864 > > Fatal error in: /usr/lib/cmplrs/cc/ld IOT/Abort trap - core dumped > > fort: Severe: Failed while trying to link. > > *** Exit 1 > > Stop. This occurs with OSF/1 V3.2. Call your customer service representative and ask for patch ID OSF320-094. This will provide you with a new linker that solves the problem. A workaround is to disable optimization during compilation. The problem occurs only with the non-shared version (f77_cc.conf, not f77_cc_shared.conf). LD_LIBRARY_PATH When running a PGPLOT program, you will probably need to add the directory containing the PGPLOT shared library to the LD_LIBRARY_PATH, e.g., in ~/.cshrc add the statement setenv LD_LIBRARY_PATH /usr/local/pgplot where "/usr/local/pgplot" is the path to the pgplot libraries libpgplot.a, and libpgplot.so; the system complains if it cannot find the shared library (*.so). LINKING PGPLOT WITH A C PROGRAM With the supplied installation procedure, Cpgdemo does not link on OSF/1. cc -DPG_PPU -c -I. /home/pmc/src/pgplot_5.0/pgplot/cpg/cpgdemo.c f77 -o cpgdemo cpgdemo.o -L`pwd` -lcpgplot -lpgplot -lX11 ld: cpgdemo.o: main: multiply defined Unresolved: MAIN__ fort: Severe: Failed while trying to link. The best solution to this is to use the flag -nofor_main on the f77 command used to link the program (thanks to David Terrett). I will try to add this in a future version of PGPLOT. An alternative suggestion, from Will Deich: ``C programs that call Fortran routines have to be linked by using the C compiler to invoke ld, NOT the Fortran compiler. (This is counter to most other Unix's.) Of course, if you are using the C compiler to invoke ld, it is possible that some necessary Fortran libraries aren't automatically linked in.'' Some of the libraries needed are -lUil -lots -lm. From John R. Thorstensen: cc demo.c -L/usr/local/pgplot -lcpgplot -lpgplot -lX11 -lm -lots -lUfor -o demo Please send any updates or corrections to me. Tim Pearson 22 April 1998 pgplot/sys_osf1/g77_gcc.conf010064400040640000322000000100500656367443700164070ustar00tjpcitmbr00000400000017# Digital UNIX [OSF/1]: the GNU g77 FORTRAN compiler and gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_vms/install.com010064400040640000322000000043100613324335600164060ustar00tjpcitmbr00000400000017$! PGPLOT Installation (OpenVMS) $! Usage: P1 = name of top-level directory of PGPLOT distribution, $! e.g., USR:[LOCAL.PGPLOT] $! P2 = option to compile (blank for default, PGDISP, CPG, or PGMDEMO) $!---------------------------------------------------------------------- $ ECHO = "WRITE SYS$OUTPUT" $! $! Find operating system version and current directory $! $ NODE = F$GETSY("NODENAME") $ CPU = F$GETSYI("HW_NAME") $ SW = F$GETSYI("NODE_SWTYPE")+F$GETSYI("NODE_SWVERS") $ PGBIN = F$ENVIRONMENT("DEFAULT") $ PGSRC = "[-.PGPLOT]" $ IF P1 .NES. "" THEN PGSRC = P1 $ PGSRC = F$PARSE(PGSRC,,,"DEVICE") + - F$PARSE(PGSRC,,,"DIRECTORY") $ PGVMS = PGSRC - "]" + ".SYS_VMS]" $ $ ECHO "------------------------------------------------------------------" $ ECHO "Installing PGPLOT ", P2, " on ", NODE, " at ", F$TIME() $ ECHO " Machine type: ", CPU $ ECHO " Software: ", SW $ ECHO "PGPLOT library, demos, and run time files will be installed" $ ECHO "in the current directory: ", PGBIN $ ECHO "from the distribution in directory: ",PGSRC $ ECHO "------------------------------------------------------------------" $ $ IF P2 .EQS. "" $ THEN $ IF F$SEARCH("RGB.TXT") .EQS. "" $ THEN $ ECHO "Copying color definition file RGB.TXT" $ COPY/LOG 'PGSRC'RGB.TXT [] $ ENDIF $ $ IF F$SEARCH("DRIVERS.LIST") .EQS. "" $ THEN $ ECHO "Copying list of available drivers DRIVERS.LIST" $ COPY 'PGSRC'DRIVERS.LIST [] $ ECHO "Please edit DRIVERS.LIST to select drivers, and then rerun this procedure" $ EXIT $ ENDIF $ $ @'PGVMS'COMPILE 'PGSRC' $ @'PGVMS'NEWEXEC $ @'PGVMS'BUILD $ @'PGVMS'LOGICAL $ @'PGVMS'MAKE_FONT 'PGSRC' $ @'PGVMS'MAKE_DEMOS 'PGSRC' $ ELSE IF P2 .EQS. "CPG" $ THEN $ @'PGVMS'MAKE_CPG 'PGSRC' $ ELSE IF P2 .EQS. "PGMDEMO" $ THEN $ @'PGVMS'MAKE_PGMDEMO 'PGSRC' $ ELSE IF P2 .EQS. "PGDISP" $ THEN $ @'PGVMS'MAKE_PGDISP 'PGSRC' $ ELSE ECHO "Option P2 = ",P2," is not recognized" $ ENDIF $ ENDIF $ ENDIF $ ENDIF $ $ ECHO "--------------------------------------------------------------" $ ECHO "PGPLOT ", P2, " installation completed at ", F$TIME() $ ECHO "--------------------------------------------------------------" $ EXIT ---------------------------------------------------------------" $ ECHO "Installing PGPLOT ", P2, " on ", NODE, " at ", F$TIME() $ ECHO " Machine type: ", CPU $ ECHO " Software: ", SW $ ECHO "PGPLOT library, demos, and run time files will be installed" $ ECHO "in the current directory: ", PGBIN $ ECHpgplot/sys_vms/build.com010064400040640000322000000307610633616140400160460ustar00tjpcitmbr00000400000017$! Rebuild PGPLOT shareable image. $! Input file: GRPCKG.OLB $! Creates: GRPSHR.EXE (shareable image) $! GRPSHR.OLB (shareable image symbol table library) $! $! A program which uses GRPCKG/PGPLOT routines can be linked $! $! either with GRPCKG.OLB/LIB, in which case the routines are $! included in the executable image by the linker in the $! usual way; $! or with GRPSHR.OLB/LIB, in which case the routines $! will be included from the shareable image at run time; $! a logical name GRPSHR must be defined at run time, $! equivalent to disk:[directory]GRPSHR.EXE $! $! - T.J. Pearson, 1-Aug-1984 $!---------------------------------------------------------------------- $ DELETE = "DELETE/NOLOG/NOCONFIRM" $ PURGE = "PURGE/NOLOG/NOCONFIRM" $! $! Check required libraries $! $ UIS = F$SEARCH("SYS$SHARE:UISSHR.EXE") $ XLIB = F$SEARCH("SYS$SHARE:DECW$XLIBSHR.EXE") $ IF UIS.EQS."" $ THEN $ WRITE SYS$OUTPUT "VAX Workstation Software (VWS) is not installed on this system" $ ELSE $ UIS = ",UIS.OPT/OPT" $ ENDIF $ IF XLIB.EQS."" $ THEN $ WRITE SYS$OUTPUT "DECwindows is not installed on this system" $ ELSE $ XLIB = ",XLIB.OPT/OPT" $ ENDIF $ CREATE UIS.OPT SYS$SHARE:UISSHR.EXE/SHARE $ CREATE XLIB.OPT SYS$SHARE:DECW$XLIBSHR.EXE/SHARE $! $! Check machine type $! $ ON WARNING THEN GOTO VAX $ MACHINE=F$GETSYI("ARCH_NAME") $ IF MACHINE .EQS. "AXP" THEN GOTO AXP $ IF MACHINE .EQS. "Alpha" THEN GOTO AXP $ GOTO VAX $!---------------------------------------------------------------------- $! OpenVMS-VAX $!---------------------------------------------------------------------- $VAX: $ ON WARNING THEN EXIT $ WRITE SYS$OUTPUT "Building PGPLOT shareable library for OpenVMS-VAX" $ WRITE SYS$OUTPUT "(Ignore any error messages about ARCH_NAME)" $! $! Create a module containing transfer vectors into the shareable image. $! This can only be done in MACRO. $! $ WRITE SYS$OUTPUT "Creating shareable image" $ MACRO/OBJECT=GRPSHRTRN SYS$INPUT .TITLE GRPSHR Transfer Vector for GRPCKG/PGPLOT .IDENT /1-50/ ; ; T.J. Pearson, 1-Jan-1984. ; ; This module contains all the transfer vectors into the shareable ; image GRPSHR. Only user-callable routines have transfer vectors. ; If you change this file and want it to be compatible with a previous ; version, you must add transfer vectors only at the end of the list. ; If you remove a transfer vector, replace it with a pointer to an ; error processing routine. ; .PSECT $TRANS,EXE,NOWRT,PIC,SHR,GBL .MACRO TRANS UNAME,LNAME .TRANSFER UNAME .IF NB LNAME .MASK LNAME JMP LNAME+2 .IFF .MASK UNAME JMP UNAME+2 .ENDC .ENDM TRANS TRANS GRAREA TRANS GRCHAR TRANS GRCHSZ TRANS GRCLOS TRANS GRCURS TRANS GRETXT TRANS GRQCI TRANS GRQDT TRANS GRQFNT TRANS GRINQLI TRANS GRQLS TRANS GRQLW TRANS GRQTYP TRANS GRLINA TRANS GRLINR TRANS GRMARK TRANS GRMOVA TRANS GRMOVR TRANS GROPEN TRANS GRPAGE TRANS GRMKER TRANS GRSLCT TRANS GRSETC TRANS GRSCI TRANS GRSFNT TRANS GRSETLI TRANS GRSLS TRANS GRSLW TRANS GRSETS TRANS GRSIZE TRANS GRCHKT TRANS GRTERM TRANS GRTEXT TRANS GRTRAN TRANS GRVECT TRANS PGADVANCE TRANS PGASK TRANS PGBEGIN TRANS PGBIN TRANS PGBOX TRANS PGCNSC TRANS PGCONT TRANS PGCURSE TRANS PGEND TRANS PGENV TRANS PGERRX TRANS PGERRY TRANS PGGRAY TRANS PGHIST TRANS PGLABEL TRANS PGLINE TRANS PGMTEXT TRANS PGNCURSE TRANS PGPOINT TRANS PGSETC TRANS PGSIZE TRANS PGTEXT TRANS PGVPORT TRANS PGVSIZE TRANS PGVSTAND TRANS PGWINDOW ; TRANS PGPAPER ; 1-02 22-Apr-1983 TRANS PGPTEXT ; 1-03 1-May-1983 TRANS PGFUNT ; 1-04 5-Oct-1983 TRANS PGFUNX TRANS PGFUNY TRANS PGNUMB TRANS PGPOLY TRANS PGUPDT TRANS PGDRAW ; 1-05 29-Dec-1983 TRANS PGMOVE TRANS PGHI2D ; 1-06 21-Feb-1984 TRANS GRSCR TRANS GRSETPEN ; 1-07 6-Jun-1984 TRANS GRINQPEN TRANS GRXHLS TRANS GRXRGB TRANS GRFA TRANS GRRECT TRANS PGLCUR TRANS PGCONS ; 1-08 27-Aug-1984 TRANS GRESC ; 1-09 15-May-1985 TRANS PGSCI ; 1-11 21-Oct-1985 TRANS PGSCF TRANS PGSCH TRANS PGSLS TRANS PGSLW TRANS PGSFS TRANS PGWNAD TRANS PGQVP TRANS PGQWIN TRANS PGRND TRANS PGIDEN TRANS PGOLIN ; 1-12 4-Nov-1985 TRANS PGQCF ; 1-13 5-Nov-1985 TRANS PGQCH TRANS PGQCI TRANS PGQCR TRANS PGQFS TRANS PGQLS TRANS PGQLW TRANS PGSCR TRANS PGRNGE TRANS PGCONX ; 1-14 18-Nov-1985 TRANS PGLDEV ; 11-Sep-1986 TRANS PGQINF ; 21-Nov-1986 TRANS PGRECT ; 21-Nov-1986 TRANS PGBBUF ; 1-16 27-Nov-1986 TRANS PGEBUF ; 27-Nov-1986 TRANS PGETXT ; 1-47 18-Feb-1988 TRANS PGSHLS ; 1-48 9-May-1988 TRANS PGPAGE TRANS PGQCOL TRANS PGCONB ; v4.9A TRANS PGTBOX ; v4.9A TRANS PGLEN ; v4.9A TRANS PGBEG ; v4.9C TRANS PGCURS ; v4.9C TRANS PGLAB ; v4.9C TRANS PGMTXT ; v4.9C TRANS PGNCUR ; v4.9C TRANS PGPAP ; v4.9C TRANS PGPT ; v4.9C TRANS PGPTXT ; v4.9C TRANS PGSVP ; v4.9C TRANS PGVSIZ ; v4.9C TRANS PGVSTD ; v4.9C TRANS PGSWIN ; v4.9C TRANS PGERRB ; v4.9D TRANS PGPNTS ; v4.9D TRANS PGQPOS ; v4.9D TRANS PGPIXL ; v4.9D TRANS PGARRO ; V4.9G TRANS PGCIRC ; V4.9G TRANS PGQAH ; V4.9G TRANS PGQVSZ ; V4.9G TRANS PGSAH ; V4.9G TRANS PGSAVE ; V4.9G TRANS PGUNSA ; V4.9G TRANS PGVECT ; V4.9G TRANS PGWEDG ; V4.9G TRANS PGQCS ; V4.9G TRANS PGSCRN ; V4.9G TRANS GRSYXD ; 24-AUG-1993 TRANS PGQTXT ; 4-OCT-1993 TRANS PGSTBG ; 16-OCT-1993 TRANS PGQTBG ; 16-OCT-1993 TRANS PGSUBP ; 15-NOV-1993 TRANS PGCONL ; 2-SEP-1994 TRANS PGERAS ; 2-SEP-1994 TRANS PGIMAG ; 2-SEP-1994 TRANS PGSCIR ; 2-SEP-1994 TRANS PGQCIR ; 2-SEP-1994 TRANS PGBAND ; 2-SEP-1994 TRANS PGCTAB ; 8-SEP-1994 TRANS PGQITF ; 13-JAN-1995 TRANS PGSITF ; 13-JAN-1995 TRANS PGPANL ; 11-FEB-1995 TRANS PGQHS ; 26-FEB-1995 TRANS PGSHS ; 26-FEB-1995 TRANS PGOPEN ; 8-APR-1996 TRANS PGCLOS ; 8-APR-1996 TRANS PGSLCT ; 8-APR-1996 TRANS PGQID ; 8-APR-1996 TRANS PGAXIS ; v5.2.0 MAY-1997 TRANS PGCONF ; v5.2.0 MAY-1997 TRANS PGERR1 ; v5.2.0 MAY-1997 TRANS PGPT1 ; v5.2.0 MAY-1997 TRANS PGSCLP ; v5.2.0 MAY-1997 TRANS PGQCLP ; v5.2.0 MAY-1997 TRANS PGQDT ; v5.2.0 MAY-1997 TRANS PGQNDT ; v5.2.0 MAY-1997 TRANS PGSCRL ; v5.2.0 MAY-1997 TRANS PGTICK ; v5.2.0 MAY-1997 ; .END $! $! Use the linker to create the shareable image, including the $! transfer vector defined above. It is linked /NOTRACEBACK to $! allow it to be INSTALLed if desired. $! $ LINK/NOMAP- /NOUSER- /NOTRACEBACK- /SHARE=GRPSHR.EXE- GRPCKG.OLB/INCLUDE=GROPEN,GRPCKG.OLB/LIB,- SYS$INPUT/OPT'UIS''XLIB' ! The following defines the version number of the shareable image. GSMATCH = LEQUAL,1,50 CLUSTER = $TRANS,,,GRPSHRTRN.OBJ ! The following PSECT list must include all the common-blocks ! declared in GRPCKG and PGPLOT. PSECT = GRCM00 ,LCL,NOSHR PSECT = GRCM01 ,LCL,NOSHR PSECT = GRCS02 ,LCL,NOSHR PSECT = GRSYMB ,LCL,NOSHR PSECT = PGPLT1 ,LCL,NOSHR PSECT = PGPLT2 ,LCL,NOSHR PSECT = GRGICO ,LCL,NOSHR $ SET FILE/PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) GRPSHRTRN.OBJ;* $ DELETE GRPSHRTRN.OBJ;* $ GOTO DONE $!---------------------------------------------------------------------- $! OpenVMS-AXP $!---------------------------------------------------------------------- $AXP: $ ON WARNING THEN EXIT $ WRITE SYS$OUTPUT "Building PGPLOT shareable library for OpenVMS-AXP" $! $! Use the linker to create the shareable image, including the $! transfer vector. It is linked /NOTRACEBACK to allow it to be INSTALLed $! if desired. $! $ LINK/NOMAP- /NOUSER- /NOTRACEBACK- /SHARE=GRPSHR.EXE- GRPCKG.OLB/INCLUDE=GROPEN,GRPCKG.OLB/LIB,- SYS$INPUT/OPT'XLIB' ! The following defines the version number of the shareable image. GSMATCH = LEQUAL,1,50 ! The following PSECT list must include all the common-blocks ! declared in GRPCKG and PGPLOT. PSECT = GRCM00 ,LCL,NOSHR PSECT = GRCM01 ,LCL,NOSHR PSECT = GRCS02 ,LCL,NOSHR PSECT = GRSYMB ,LCL,NOSHR PSECT = PGPLT1 ,LCL,NOSHR PSECT = PGPLT2 ,LCL,NOSHR PSECT = GRGICO ,LCL,NOSHR ! Transfer vectors: Only user-callable routines have transfer vectors. ! If you change this file and want it to be compatible with a previous ! version, you must add transfer vectors only at the end of the list. ! If you remove a transfer vector, replace it with a pointer to an ! error processing routine. SYMBOL_VECTOR=(GRAREA=PROCEDURE,- GRCHAR=PROCEDURE,- GRCHSZ=PROCEDURE,- GRCLOS=PROCEDURE,- GRCURS=PROCEDURE,- GRETXT=PROCEDURE,- GRQCI=PROCEDURE,- GRQDT=PROCEDURE,- GRQFNT=PROCEDURE,- GRINQLI=PROCEDURE,- GRQLS=PROCEDURE,- GRQLW=PROCEDURE,- GRQTYP=PROCEDURE,- GRLINA=PROCEDURE,- GRLINR=PROCEDURE,- GRMARK=PROCEDURE,- GRMOVA=PROCEDURE,- GRMOVR=PROCEDURE,- GROPEN=PROCEDURE,- GRPAGE=PROCEDURE,- GRMKER=PROCEDURE,- GRSLCT=PROCEDURE,- GRSETC=PROCEDURE,- GRSCI=PROCEDURE,- GRSFNT=PROCEDURE,- GRSETLI=PROCEDURE,- GRSLS=PROCEDURE,- GRSLW=PROCEDURE,- GRSETS=PROCEDURE,- GRSIZE=PROCEDURE,- GRCHKT=PROCEDURE,- GRTERM=PROCEDURE,- GRTEXT=PROCEDURE,- GRTRAN=PROCEDURE,- GRVECT=PROCEDURE,- PGADVANCE=PROCEDURE,- PGASK=PROCEDURE,- PGBEGIN=PROCEDURE,- PGBIN=PROCEDURE,- PGBOX=PROCEDURE,- PGCNSC=PROCEDURE,- PGCONT=PROCEDURE,- PGCURSE=PROCEDURE,- PGEND=PROCEDURE,- PGENV=PROCEDURE,- PGERRX=PROCEDURE,- PGERRY=PROCEDURE,- PGGRAY=PROCEDURE,- PGHIST=PROCEDURE,- PGLABEL=PROCEDURE,- PGLINE=PROCEDURE,- PGMTEXT=PROCEDURE,- PGNCURSE=PROCEDURE,- PGPOINT=PROCEDURE,- PGSETC=PROCEDURE,- PGSIZE=PROCEDURE,- PGTEXT=PROCEDURE,- PGVPORT=PROCEDURE,- PGVSIZE=PROCEDURE,- PGVSTAND=PROCEDURE,- PGWINDOW=PROCEDURE,- PGPAPER=PROCEDURE,- PGPTEXT=PROCEDURE,- PGFUNT=PROCEDURE,- PGFUNX=PROCEDURE,- PGFUNY=PROCEDURE,- PGNUMB=PROCEDURE,- PGPOLY=PROCEDURE,- PGUPDT=PROCEDURE,- PGDRAW=PROCEDURE,- PGMOVE=PROCEDURE,- PGHI2D=PROCEDURE,- GRSCR=PROCEDURE,- GRSETPEN=PROCEDURE,- GRINQPEN=PROCEDURE,- GRXHLS=PROCEDURE,- GRXRGB=PROCEDURE,- GRFA=PROCEDURE,- GRRECT=PROCEDURE,- PGLCUR=PROCEDURE,- PGCONS=PROCEDURE,- GRESC=PROCEDURE,- PGSCI=PROCEDURE,- PGSCF=PROCEDURE,- PGSCH=PROCEDURE,- PGSLS=PROCEDURE,- PGSLW=PROCEDURE,- PGSFS=PROCEDURE,- PGWNAD=PROCEDURE,- PGQVP=PROCEDURE,- PGQWIN=PROCEDURE,- PGRND=PROCEDURE,- PGIDEN=PROCEDURE,- PGOLIN=PROCEDURE,- PGQCF=PROCEDURE,- PGQCH=PROCEDURE,- PGQCI=PROCEDURE,- PGQCR=PROCEDURE,- PGQFS=PROCEDURE,- PGQLS=PROCEDURE,- PGQLW=PROCEDURE,- PGSCR=PROCEDURE,- PGRNGE=PROCEDURE,- PGCONX=PROCEDURE,- PGLDEV=PROCEDURE,- PGQINF=PROCEDURE,- PGRECT=PROCEDURE,- PGBBUF=PROCEDURE,- PGEBUF=PROCEDURE,- PGETXT=PROCEDURE,- PGSHLS=PROCEDURE,- PGPAGE=PROCEDURE,- PGQCOL=PROCEDURE,- PGCONB=PROCEDURE,- PGTBOX=PROCEDURE,- PGLEN=PROCEDURE,- PGBEG=PROCEDURE,- PGCURS=PROCEDURE,- PGLAB=PROCEDURE,- PGMTXT=PROCEDURE,- PGNCUR=PROCEDURE,- PGPAP=PROCEDURE,- PGPT=PROCEDURE,- PGPTXT=PROCEDURE,- PGSVP=PROCEDURE,- PGVSIZ=PROCEDURE,- PGVSTD=PROCEDURE,- PGSWIN=PROCEDURE,- PGERRB=PROCEDURE,- PGPNTS=PROCEDURE,- PGQPOS=PROCEDURE,- PGPIXL=PROCEDURE,- PGARRO=PROCEDURE,- PGCIRC=PROCEDURE,- PGQAH=PROCEDURE,- PGQVSZ=PROCEDURE,- PGSAH=PROCEDURE,- PGSAVE=PROCEDURE,- PGUNSA=PROCEDURE,- PGVECT=PROCEDURE,- PGWEDG=PROCEDURE,- PGQCS=PROCEDURE,- PGSCRN=PROCEDURE,- GRSYXD=PROCEDURE,- PGQTXT=PROCEDURE,- PGSTBG=PROCEDURE,- PGQTBG=PROCEDURE,- PGSUBP=PROCEDURE,- PGCONL=PROCEDURE,- PGERAS=PROCEDURE,- PGIMAG=PROCEDURE,- PGSCIR=PROCEDURE,- PGQCIR=PROCEDURE,- PGBAND=PROCEDURE,- PGCTAB=PROCEDURE,- PGQITF=PROCEDURE,- PGSITF=PROCEDURE,- PGPANL=PROCEDURE,- PGQHS=PROCEDURE,- PGSHS=PROCEDURE,- PGOPEN=PROCEDURE,- PGCLOS=PROCEDURE,- PGSLCT=PROCEDURE,- PGQID=PROCEDURE,- PGAXIS=PROCEDURE,- PGCONF=PROCEDURE,- PGERR1=PROCEDURE,- PGPT1=PROCEDURE,- PGSCLP=PROCEDURE,- PGQCLP=PROCEDURE,- PGQDT=PROCEDURE,- PGQNDT=PROCEDURE,- PGSCRL=PROCEDURE,- PGTICK=PROCEDURE- ) $ GOTO DONE $!---------------------------------------------------------------------- $DONE: $ SET FILE/PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) GRPSHR.EXE;* $ PURGE GRPSHR.EXE $ DELETE UIS.OPT;*,XLIB.OPT;* $! $! Create a Shareable Image Symbol Table Library to contain the $! symbol table for GRPCKG; this library (GRPSHR.OLB) should be $! linked with the user's program in place of the object-module $! library (GRPCKG.OLB) in order to use the shareable image. $! $ LIBRARY/CREATE=(BLOCKS:12,MODULES:1)/SHARE GRPSHR.OLB GRPSHR.EXE $ PURGE GRPSHR.OLB $ SET FILE/PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) GRPSHR.OLB $ DEFINE/NOLOG GRPSHR 'F$SEARCH("GRPSHR.EXE")' 7-Aug-1984 TRApgplot/sys_vms/grsy00.f010064400040640000322000000062370576744151500155560ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition [VMS] C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C----------------------------------------------------------------------- INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', READONLY, IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END pgplot/sys_vms/make_cpg.com010064400040640000322000000036600613305424700165140ustar00tjpcitmbr00000400000017$! DCL command procedure to compile C binding for PGPLOT for $! OpenVMS VAX and AXP $!---------------------------------------------------------------------- $ DELETE = "DELETE/NOLOG/NOCONFIRM" $ PURGE = "PURGE/NOLOG/NOCONFIRM" $! $ ON WARNING THEN EXIT $ PROC = P1 $ IF PROC.EQS."" THEN PROC = "[]" $ PGPLOT = F$PARSE(PROC,,,"DEVICE","SYNTAX_ONLY") + - F$PARSE(PROC,,,"DIRECTORY","SYNTAX_ONLY") $ CPG = PGPLOT - "]" + ".CPG]" $ SRC = PGPLOT - "]" + ".SRC]" $ ECHO = "WRITE SYS$OUTPUT" $! $! Check for VMS or AXP. $! $ ON WARNING THEN GOTO VAX $ MACHINE=F$GETSYI("ARCH_NAME") $ GOTO START $ VAX: MACHINE="VAX" $ START: ON WARNING THEN GOTO EXIT $! $! Compile the PGBIND program. $! $ ECHO "Compiling PGBIND for OpenVMS ", MACHINE $ CC 'CPG'PGBIND.C $ IF MACHINE .EQS. "VAX" $ THEN $ LINK PGBIND, SYS$INPUT:/OPT SYS$SHARE:VAXCRTL/SHARE $ ELSE $ LINK PGBIND $ ENDIF $ PGBIND == "$"+F$SEARCH("PGBIND.EXE", 3) $! $! Run PGBIND to generate the header file and wrapper routines. $! $ ECHO "Creating C header file and C wrapper routines" $ SEARCH 'SRC'PG*.F "C%" /NOHEADING/OUTPUT=PROTO.TXT $ PGBIND vms -h -w PROTO.TXT $! $! Compile them. $! $ ECHO "Compiling C wrapper routines" $ FILES = "CPG*.C" $LOOP: $ FILE = F$SEARCH(FILES,1) $ IF FILE .EQS. "" THEN GOTO ENDLOOP $ NAME = F$PARSE(FILE,,,"NAME","SYNTAX_ONLY") $ ECHO NAME $ CC/NOWARNINGS 'FILE' $ GOTO LOOP $ ENDLOOP: $! $! Create the library. $! $ ECHO "Creating PGPLOT C interface library" $ LIBRARY/CREATE/NOLOG CPGPLOT.OLB CPG*.OBJ $ PURG CPGPLOT.OLB $! $! Remove intermediate files. $! $ DELETE pgbind.obj;*,pgbind.exe;*,cpg*.obj;*,cpg*.c;*,proto.txt;* $! $! Compile the demo program. $! $ ECHO "Compiling demo program CPGDEMO" $ CC 'CPG'CPGDEMO /INCLUDE_DIRECTORY=[] $ LINK/NOUSER CPGDEMO,CPGPLOT.OLB/LIB,GRPSHR.OLB/LIB $ DELETE CPGDEMO.OBJ;* $ PURGE CPGDEMO.EXE $ SET PROT=(S:RWED,O:RWED,G:RE,W:RE) cpgplot.h, cpgplot.olb, cpgdemo.exe $! $ EXIT: EXIT OT - "]" + ".CPG]" $ SRC = PGPLOT - "]" + ".SRC]" $ ECHO = "WRITE SYS$Opgplot/sys_vms/grdate.f010064400040640000322000000014600546005624300156570ustar00tjpcitmbr00000400000017 C*GRDATE -- get date and time as character string (VMS) C+ SUBROUTINE GRDATE(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the STRING should be declared C CHARACTER*17. C C Arguments: C STRING : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 19-Jan-1988 C----------------------------------------------------------------------- INTEGER LIB$DATE_TIME INTEGER IER C STRING = ' ' L = MIN(17,LEN(STRING)) IER = LIB$DATE_TIME(STRING(:L)) END pgplot/sys_vms/grflun.f010064400040640000322000000006250546005624300157100ustar00tjpcitmbr00000400000017 C*GRFLUN -- free a Fortran logical unit number (VMS) C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. C C Arguments: C LUN : the logical unit number to free. C-- C 25-Nov-1988 C----------------------------------------------------------------------- INTEGER LIB$FREE_LUN, JUNK C JUNK = LIB$FREE_LUN(LUN) RETURN END pgplot/sys_vms/grgcom.f010064400040640000322000000017320652616047200156750ustar00tjpcitmbr00000400000017 C*GRGCOM -- read with prompt from user's terminal (VMS) C+ INTEGER FUNCTION GRGCOM(STRING, PROMPT, L) CHARACTER*(*) STRING, PROMPT INTEGER L C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C STRING : (output) receives the string read from the terminal. C PROMPT : (input) prompt string. C L : (output) length of STRING. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 9-Feb-1988 C 12-May-1998: workaround for VMS bug, provided by Magnus Zolliker; the C extra CR//LF is sometimes required if the terminal is used as C a graphics device of type /TEK or similar. C----------------------------------------------------------------------- INTEGER CR, LF PARAMETER (CR=13, LF=10) INTEGER LIB$GET_COMMAND C GRGCOM = LIB$GET_COMMAND(STRING, CHAR(CR)//CHAR(LF)//PROMPT, L) IF (GRGCOM.NE.1) GRGCOM = 0 END pgplot/sys_vms/grge00.f010064400040640000322000000126740546005624300155060ustar00tjpcitmbr00000400000017 C*GRGE00 -- open output device; device handler routine (VMS) C+ INTEGER FUNCTION GRGE00(CTYP,LUN,CHR,LCHR) C C General routine to open plot device. This version can open C 1) A file with of any FORM and CARRIAGECONTROL, C 2) Any local device for QIO operations, C 3) A remote device over a network using a network task on the C remote node. C If an error occurs, a message is sent to SYS$OUTPUT via GRWARN. C C Arguments: C- CTYP(1:1)='F' I/O will use standard Fortran I/O and C- CTYP(2:2) ='F' for formatted, ='U' for unformatted. C- CTYP(3:3) ='L' for LIST, ='N' for 'NONE carriagecontrol C- LUN return, logical unit number of file. C- CHR(:LCHR) input, name of file to open. C- CTYP(1:1)='Q' for DEC QIO and C- CTYP(2:2) ='1' for device type 66 expected. C- CTYP(2:2) ='2' for device type 96 expected. C- LUN return, channel number of opened channel, C- CHR(:LCHR) input, name of device to open. C C GRGE00 (returns integer): 0 if the device/channel could C not be opened, 1 if the file/channel was opened C successfully on a local device, 3 for a successful open C of a channel over a network (the remote status of the C device must be flagged since, the QIO functions codes are C different when writting to a physical device or to the C network). C-- C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER DVI$_DEVCLASS, DVI$_DEVNAM PARAMETER (DVI$_DEVCLASS=4) PARAMETER (DVI$_DEVNAM=32) INTEGER LUN,LCHR CHARACTER*(*) CTYP,CHR CHARACTER*16 CFORM,CONTRL INTEGER GRCHKT, I, IER, IK1, IK2, IK3, IK4, IK5, ITEMP INTEGER DEVCLASS, ITMLIST(7), MOSB(2), ISTAT, LENGTH INTEGER SYS$ASSIGN, SYS$QIOW INTEGER SYS$GETDVI, SYS$DASSGN, SYS$WAITFR INTEGER*2 IOSB(4) LOGICAL WRONG C IF(CTYP(1:1).EQ.'F') THEN CALL GRGLUN(LUN) CFORM=' ' IF(CTYP(2:2).EQ.'F') CFORM='FORMATTED' IF(CTYP(2:2).EQ.'U') CFORM='UNFORMATTED' CONTRL=' ' IF(CTYP(3:3).EQ.'N') CONTRL='NONE' IF(CTYP(3:3).EQ.'L') CONTRL='LIST' OPEN (UNIT=LUN,FILE=CHR(:LCHR),STATUS='NEW', & FORM=CFORM, CARRIAGECONTROL=CONTRL, & RECL=512,IOSTAT=IER) IF (IER.NE.0) THEN CALL ERRSNS(IK1,IK2,IK3,IK4,IK5) CALL GRWARN('Cannot open graphics device ' 1 //CHR(1:LCHR)) IF (IK2.NE.0 .AND. IK2.NE.1) CALL GRGMSG(IK2) IF (IK5.NE.0 .AND. IK5.NE.1) CALL GRGMSG(IK5) GRGE00 = 0 ELSE INQUIRE (UNIT=LUN, NAME=CHR) I = LEN(CHR) DO WHILE (CHR(I:I).EQ.' ') I = I-1 END DO LCHR= I IF (GRCHKT(CHR(1:I))) THEN CALL GRWARN('Cannot send printer plot to terminal.') GRGE00 = 0 ELSE GRGE00 = 1 END IF END IF ELSE IF(CTYP(1:1).EQ.'Q') THEN C C Assign an i/o channel. C IER = SYS$ASSIGN(CHR(:LCHR), LUN,,) IF(IER.NE.SS$_NORMAL .AND. IER.NE.SS$_REMOTE) GOTO 100 IF (IER .EQ. SS$_REMOTE) THEN C C Cannot check device characteristics easily if network device being used C so just check whether we opened the device successfully and return C Read back the status from assign to plotting device over network C IER=SYS$QIOW(,%VAL(LUN),%VAL(IO$_READVBLK), : IOSB,,,ISTAT,LENGTH,,,,) IF (IOSB(1) .NE. SS$_NORMAL) THEN CALL GRWARN ('Unable to read status from ASSIGN to' // : ' graphics device on remote node') WRITE(6,*) IOSB(2), ' bytes read' ITEMP=IOSB(1) CALL GRGMSG(ITEMP) GRGE00=0 RETURN END IF IF (ISTAT .NE. SS$_NORMAL) THEN IER=ISTAT GOTO 100 ELSE GRGE00=3 RETURN END IF END IF C--- C Check that device has correct characteristics, C and obtain true device name. C ITMLIST(1) = DVI$_DEVCLASS*2**16 + 4 ITMLIST(2) = %LOC(DEVCLASS) ITMLIST(3) = 0 ITMLIST(4) = DVI$_DEVNAM*2**16 + LEN(CHR) ITMLIST(5) = %LOC(CHR) ITMLIST(6) = %LOC(LCHR) ITMLIST(7) = 0 IER = SYS$GETDVI(%VAL(0),,CHR(:LCHR), 1 ITMLIST,MOSB,,,) IF (.NOT.IER) GOTO 100 IER = SYS$WAITFR(%VAL(0)) IF (.NOT.IER) GOTO 100 IF (.NOT.MOSB(1)) THEN IER = MOSB(1) GOTO 100 END IF IF (CTYP(2:2).EQ.'1') THEN WRONG = DEVCLASS.NE.66 ELSE IF(CTYP(2:2).EQ.'2') THEN WRONG = DEVCLASS.NE.96 ELSE TYPE *,'DEVCLASS=',DEVCLASS END IF IF (WRONG) THEN CALL GRWARN( CHR(:LCHR)// 2 ' is the wrong sort of device for plot type.') GRGE00 = 0 ! indicate error IER = SYS$DASSGN(%VAL(LUN)) RETURN END IF C C Successful completion. C GRGE00 = 1 END IF RETURN C C Error exit. C 100 CALL GRWARN('Cannot open graphics device '//CHR(:LCHR)) CALL GRGMSG(IER) GRGE00 = 0 END )='F' I/O will use standard Fortran I/O and C- CTYP(2:2) pgplot/sys_vms/grge02.f010064400040640000322000000021100546005624300154700ustar00tjpcitmbr00000400000017C*GRGE02 C+ SUBROUTINE GRGE02(STR, N, QBUF,ICNT,MXCNT) C C GRPCKG (internal routine for general driver): transfer N bytes to C the output buffer, flushing the buffer as necessary with the C GRGE03 routine. Based on early versions of GRxx02 routines. C This version does not used any common blocks. C ***NOTE*** INIT03 must be called before any calls to GRGE02 to C set the LUN/Channel to which the buffer should be dumped. C C Arguments: C C STR(N) I Byte Characters to be written. C N I I The number of bytes to transfer. C QBUF I/O Byte The output buffer. C ICNT I/O I Current number of bytes used in QBUF. C MXCNT I/O I Maximum number of bytes that can be stored C in QBUF. C C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- IMPLICIT NONE INTEGER ICNT,MXCNT,I,N BYTE QBUF(N), STR(N) C--- DO I=1,N IF (ICNT.GE.MXCNT) CALL GRGE03(QBUF,ICNT) ICNT = ICNT+1 QBUF(ICNT) = STR(I) END DO RETURN END pgplot/sys_vms/grge03.f010064400040640000322000000037630546005624400155110ustar00tjpcitmbr00000400000017C*GRGE03 C+ SUBROUTINE GRGE03(QBUF,ICNT) C C GRPCKG (Internal routine): Write ICNT bytes in QBUF onto logical C unit LUN. Reset ICNT to zero. C Based on GRxx03 routines, this version does not contain a common C block. C ***NOTE*** INIT03 must be called before any calls to GRGE02 to C set the LUN/Channel to which the buffer should be dumped. C This subroutine contains the entry point INIT03 that defines C the variables ITYPE, LUN and IFUNC. If ITYPE=0 then LUN is C the Fortran logical unit number to which the data should be C written. If ITYPE>0 then LUN is the Channel number for a QIO C operation and IFUNC is the QIO write function. C C Arguments: C C QBUF I/O Byte The output buffer. C ICNT I/O I Current number of bytes used in QBUF. C C 5-Aug-1986 - [AFT]. C----------------------------------------------------------------------- IMPLICIT NONE INCLUDE '($SSDEF)' INTEGER SYS$QIOW INTEGER ICNT BYTE QBUF(*) INTEGER RESULT, N, I INTEGER*2 IOSB(4) INTEGER INTYPE,INLUN,INFUNC INTEGER ITYPE,LUN,IFUNC SAVE ITYPE,LUN,IFUNC C N = ICNT ICNT = 0 IF (N.LT.1) RETURN C IF(ITYPE.EQ.0) THEN WRITE(LUN,101, ERR=900) (QBUF(I),I=1,N) 101 FORMAT(130A1) ELSE RESULT = SYS$QIOW(,%VAL(LUN), 1 %VAL(IFUNC),IOSB,,, 2 QBUF,%VAL(N),%VAL(5),,,) IF (RESULT.NE.SS$_NORMAL) THEN CALL GRGMSG(RESULT) CALL GRGMSG('SYS$QIOW error writing to device. '// & 'Program continues.') END IF IF (IOSB(1).NE.SS$_NORMAL) THEN CALL GRGMSG(IOSB(1)) CALL GRGMSG('SYS$QIOW (IOSB) status writing to device. '// & 'Program continues.') END IF END IF RETURN C--- 900 CONTINUE RETURN C--- ENTRY INIT03(INTYPE,INLUN,INFUNC) C--- Save info needed to dump buffer. ITYPE=INTYPE LUN=INLUN IFUNC=INFUNC RETURN END pgplot/sys_vms/grgenv.f010064400040640000322000000030560546005624400157050ustar00tjpcitmbr00000400000017 C*GRGENV -- get value of PGPLOT environment parameter (VMS) C+ SUBROUTINE GRGENV(NAME, VALUE, L) CHARACTER*(*) NAME, VALUE INTEGER L C C Return the value of a PGPLOT environment parameter. In VMS, C environment parameters are VMS logical names; e.g. parameter C ENVOPT is logical name PGPLOT_ENVOPT. Translation is not C recursive and is case-sensitive. C [For historical compatibility, if name PGPLOT_XX is not found, C this routine will also look for PLT$XX.] C C Arguments: C NAME : (input) the name of the parameter to evaluate. C VALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C L : receives the number of characters in VALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 19-Jan-1988 C----------------------------------------------------------------------- INTEGER I, LIN, IER, LIB$SYS_TRNLOG CHARACTER*32 TEST C TEST = 'PGPLOT_'//NAME LIN = INDEX(TEST, ' ')-1 IER = LIB$SYS_TRNLOG(TEST(:LIN),L,VALUE) IF (IER.NE.1) THEN TEST = 'PLT$'//NAME LIN = INDEX(TEST, ' ')-1 IER = LIB$SYS_TRNLOG(TEST(:LIN),L,VALUE) END IF IF (IER.NE.1 .OR. L.LT.1 .OR. VALUE.EQ.' ') THEN L = 0 VALUE = ' ' ELSE DO 10 I=L,1,-1 L = I IF (VALUE(I:I).NE.' ') GOTO 20 10 CONTINUE L = 0 20 CONTINUE END IF END pgplot/sys_vms/grgetc.f010064400040640000322000000067460546005624400157010ustar00tjpcitmbr00000400000017C*GRGETC -- read a single character from keyboard (VMS) C+ INTEGER FUNCTION GRGETC (CHAN) C C Read a single character from the controlling keyboard, no echo. C Normal ASCII characters are returned as the corresponding integer C codes. Escape sequences generated by the VT100 are recognised and C returned as negative integer codes. Some characters (eg control-U, C control-R, delete, control-C, control-Y) are normally intercepted C by the operating system and cannot be read with GRGETC. C C Argument: C C CHAN (input, integer): the channel number assigned to the terminal; C this must have been previously assigned by SYS$ASSIGN. C C Returns: C C GRGETC (integer): either a positive number (0-127) equal to C the ASCII code of the character read, or a negative number, as C follows, if one of the VT100 escape sequences has been read: C UP ARROW, DOWN ARROW, RIGHT ARROW, LEFT ARROW: -1,-2,-3,-4; C PF1, PF2, PF3, PF4: -11,-12,-13,-14. C If the terminal is in "alternate keypad mode", the following C codes are generated by typing the keypad keys: C Keypad digits 0 through 9: -20 through -29; C Keypad ENTER: -8; C Keypad comma, minus, period: -16,-17,-18. C If an unrecognized escape sequence is received, GRGETC is set C to zero. C-- C (7-Feb-1983) C----------------------------------------------------------------------- INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INTEGER IOFUNC PARAMETER (IOFUNC=IO$_READVBLK.OR.IO$M_NOECHO.OR.IO$M_ESCAPE) INTEGER CHAN, IER, SYS$QIOW, TERMSK(2), J INTEGER*2 IOSB(4), CODE_TABLE(22) BYTE TERMCH(32),BUFFER(20), VALID_TABLE(22) DATA TERMCH/32*'FF'X/ DATA TERMSK(1) / 32 / C C Valid escape sequences are O or [ C followed by one of the characters in VALID_TABLE; C CODE_TABLE contains the corresponding integer codes C returned by GRGETC. C DATA VALID_TABLE/ 'A','B','C','D', 'P','Q','R','S', 1 'p','q','r','s','t','u','v','w','x','y', 2 'm','l','n', 'M'/ DATA CODE_TABLE/ -1,-2,-3,-4, -11,-12,-13,-14, 1 -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, 2 -17,-16,-18, -8/ C C Read a single character; all characters are C terminators, and escape sequences are recognised. C TERMSK(2) = %LOC(TERMCH) IER = SYS$QIOW(, %VAL(CHAN), %VAL(IOFUNC), IOSB, , , 1 BUFFER, ! P1 (buffer address) 2 %VAL(20), ! P2 (buffer size) 3 , ! P3 (timeout count) 4 TERMSK, ! P4 (read terminator descr.block) 5 , ! P5 (prompt buffer address) 6 ) ! P6 (prompt buffer size) IF (IER.NE.1) THEN CALL GRGMSG(IER) CALL GRQUIT('Fatal error in PGPLOT routine GRGETC') END IF C C If terminator is a single character, return it. C IF (IOSB(4).EQ.1) THEN GRGETC = BUFFER(1) RETURN C C If terminator is an escape sequence, interpret it. C ELSE IF ((BUFFER(1).EQ.27) .AND. 1 (BUFFER(2).EQ.79 .OR. BUFFER(2).EQ.91)) THEN DO J=1,22 IF (BUFFER(3).EQ.VALID_TABLE(J)) THEN GRGETC = CODE_TABLE(J) RETURN END IF END DO END IF C C Otherwise, return zero. C GRGETC = 0 RETURN END OR.IO$M_NOECHO.OR.IO$M_ESCpgplot/sys_vms/grglun.f010064400040640000322000000006640546005624400157150ustar00tjpcitmbr00000400000017 C*GRGLUN -- get a Fortran logical unit number (VMS) C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Return an unused Fortran logical unit number. C C Arguments: C LUN : receives the logical unit number, or -1 on error. C-- C 25-Nov-1988 C----------------------------------------------------------------------- INTEGER IER, LIB$GET_LUN C IER = LIB$GET_LUN(LUN) IF (IER.NE.1) LUN = -1 RETURN END pgplot/sys_vms/grgmsg.f010064400040640000322000000011620546005624400156770ustar00tjpcitmbr00000400000017 C*GRGMSG -- print system message (VMS) C+ SUBROUTINE GRGMSG (STATUS) INTEGER STATUS C C This routine obtains the text of the VMS system message corresponding C to code STATUS, and displays it using routine GRWARN. C C Argument: C STATUS (input): 32-bit system message code. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER*80 BUFFER INTEGER LENGTH, MSGLEN C CALL SYS$GETMSG(%VAL(STATUS),MSGLEN,BUFFER,%VAL(1),) LENGTH = INDEX(BUFFER(1:MSGLEN),'!') IF (LENGTH.GT.1) MSGLEN = LENGTH-1 CALL GRWARN(BUFFER(1:MSGLEN)) END pgplot/sys_vms/grtermio.f010064400040640000322000000061700651751252400162470ustar00tjpcitmbr00000400000017C********* SUBROUTINE GRCTER(ICHAN) INTEGER ICHAN C--- C Close a previously opened channel. C--- C ICHAN I The channel number to be closed C--- CALL SYS$DASSGN(%val(ICHAN)) RETURN END INTEGER FUNCTION GROTER(CDEV, LDEV) CHARACTER CDEV*(*) INTEGER LDEV C--- C Open a channel to the device specified by CDEV. C--- C CDEV I The name of the device to be opened C LDEV I Number of valid characters in device C GROTER O The open channel number (-1 indicates an error) C--- INTEGER ICHAN C--- CALL SYS$ASSIGN(CDEV(:LDEV),ICHAN,,) GROTER=ICHAN RETURN END C********* SUBROUTINE GRWTER(ICHAN, CBUF, LBUF) CHARACTER CBUF*(*) INTEGER ICHAN, LBUF C--- C Write LBUF bytes from CBUF to the channel ICHAN. Data is written C with no formatting. C--- C ICHAN I The channel number C CBUF I Character array of data to be written C LBUF I/O The number of bytes to write, set to zero on return C--- INCLUDE '($IODEF)' C--- CALL SYS$QIOW(,%val(ICHAN), : %val(IO$_WRITEVBLK.OR.IO$M_NOFORMAT),,,, : %ref(CBUF),%val(LBUF),,,,) LBUF=0 RETURN END C********* SUBROUTINE GRPTER(ICHAN, PROMPT, LPROM, CBUF, LBUF) CHARACTER PROMPT*(*), CBUF*(*) INTEGER ICHAN, LPROM, LBUF C--- C revised 3-Jun-1997: use NOFILTR to pass DEL etc. C 12-Mar-1998: change timeout behavior (M.Zolliker) C--- INCLUDE '($SSDEF)' INCLUDE '($IODEF)' INTEGER IREAD1,IREAD PARAMETER (IREAD1= IO$M_PURGE + IO$M_NOFORMAT + IO$M_NOFILTR + : IO$M_NOECHO + IO$_READPROMPT) PARAMETER (IREAD= IO$M_NOFORMAT + IO$M_NOFILTR + : IO$M_NOECHO + IO$M_TIMED + IO$_TTYREADALL) INTEGER ITIME PARAMETER (ITIME=5) C IOSB(1): status C IOSB(2): character count INTEGER*2 IOSB(4) C--- C wait indefinitely for the first character CALL SYS$QIOW(,%VAL(ICHAN),%VAL(IREAD1),IOSB,,, : %REF(CBUF),%VAL(1),,, : %REF(PROMPT),%VAL(LPROM)) IF (IOSB(1) .EQ. SS$_NORMAL) THEN C wait 4-5 sec. for each of the following characters CALL SYS$QIOW(,%VAL(ICHAN),%VAL(IREAD),IOSB,,, : %REF(CBUF(2:)),%VAL(LBUF-1),%VAL(ITIME),, : %REF(PROMPT),%VAL(LPROM)) IOSB(2)=IOSB(2)+1 ENDIF LBUF=IOSB(2) RETURN END C********* SUBROUTINE GRRTER(ICHAN, CBUF, LBUF) CHARACTER CBUF*(*) INTEGER ICHAN, LBUF C--- C Read LBUF bytes from device assigned to channel ICHAN to CBUF. C Previous unread data is purged. Data is read without format C or echo. C--- C ICHAN I The channel number C CBUF O Character array of data read C LBUF I/O The number of bytes to write, set to zero on return C--- INCLUDE '($IODEF)' INTEGER IREAD PARAMETER (IREAD= IO$_TTYREADALL + IO$M_PURGE + IO$M_NOFORMAT + : IO$M_NOECHO + IO$M_TIMED) INTEGER ITIME PARAMETER (ITIME=60) INTEGER IQUAD0(2) DATA IQUAD0/0,0/ C--- CALL SYS$QIOW(,%val(ICHAN),%val(IREAD),,,, : %ref(CBUF),%val(LBUF),%val(ITIME),IQUAD0,,) RETURN END pgplot/sys_vms/groptx.f010064400040640000322000000017130546005624500157370ustar00tjpcitmbr00000400000017C*GROPTX -- open text file for input or output (VMS) C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE) INTEGER UNIT, MODE CHARACTER*(*) NAME, DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C MODE : 0 for input, 1 for output C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER IF (MODE.EQ.1) THEN OPEN (UNIT=UNIT, 1 FILE=NAME, 2 STATUS='NEW', 3 CARRIAGECONTROL='LIST', 4 DEFAULTFILE=DEFNAM, 5 RECL=2048, 6 IOSTAT=IER) ELSE OPEN (UNIT=UNIT, 1 FILE=NAME, 2 STATUS='OLD', 3 READONLY, 6 IOSTAT=IER) END IF GROPTX = IER C----------------------------------------------------------------------- END pgplot/sys_vms/grchkt.f010064400040640000322000000016460546005624200157000ustar00tjpcitmbr00000400000017C*GRCHKT -- determine whether a device is a terminal (VMS) C+ INTEGER FUNCTION GRCHKT (TERM) CHARACTER*(*) TERM C C Argument: C TERM (input): the name of the device according to VMS C conventions, ie a physical device name (_TTA4:) or a logical C name. C C Returns: C GRCHKT (integer): a TRUE value (odd) if TERM is a terminal device, C a FALSE value otherwise. C-- C 1-Feb-1983 C 24-Jan-1986 - use LIB$GETDVI [TJP]. C----------------------------------------------------------------------- INTEGER DC$_TERM, DVI$_DEVCLASS PARAMETER (DC$_TERM=66) PARAMETER (DVI$_DEVCLASS=4) C INTEGER DEVCLASS, IER, LIB$GETDVI C IER = LIB$GETDVI(DVI$_DEVCLASS, , TERM, DEVCLASS) IF (IER.NE.1) THEN GRCHKT = IER ELSE IF (DEVCLASS.EQ.DC$_TERM) THEN GRCHKT = 1 ELSE GRCHKT = 4828 ! "input device is not a terminal" END IF C END pgplot/sys_vms/grlgtr.f010064400040640000322000000025630621637365400157270ustar00tjpcitmbr00000400000017C*GRLGTR -- translate logical name (VMS) C+ SUBROUTINE GRLGTR (NAME) CHARACTER*(*) NAME C C This is used in the parsing of device specifications in the C VMS implementation of PGPLOT. In other implementations, it may C be replaced by a null routine. C C Argument: C NAME (input/output): initially contains the name to be C inspected. If an equivalence is found it will be replaced C with the new name. If not, the old name will be left there. C-- C (1-Feb-1983) C 10-Apr-1996: remove uppercasing; logical names may be case-sensitive. C 13-Sep-1996: new version using $TRNLNM; not recursive. C----------------------------------------------------------------------- INCLUDE '($LNMDEF)' INCLUDE '($SYSSRVNAM)' STRUCTURE /LIST/ INTEGER*2 BUF_LEN/255/ INTEGER*2 ITEM_CODE/LNM$_STRING/ INTEGER*4 TRANS_LOG INTEGER*4 TRANS_LEN INTEGER*4 END_ENTRY/0/ END STRUCTURE CHARACTER*255 EQV_BUFFER INTEGER*2 W_NAMELEN INTEGER L, GRTRIM, ISTAT RECORD /LIST/ ITEM_LIST ITEM_LIST.TRANS_LOG = %LOC(EQV_BUFFER) ITEM_LIST.TRANS_LEN = %LOC(W_NAMELEN) L = GRTRIM(NAME) ISTAT = SYS$TRNLNM(LNM$M_CASE_BLIND, : 'LNM$FILE_DEV', : NAME(1:L), : , : ITEM_LIST) IF (ISTAT) NAME = EQV_BUFFER(:W_NAMELEN) RETURN END pgplot/sys_vms/compile.com010064400040640000322000000075410661514611000163740ustar00tjpcitmbr00000400000017$! Recompile PGPLOT. $! Input files: [.SRC]*.F, PGPLOT.INC, GRPCKG1.INC $! [.SYS_VMS]*.F $! [.DRIVERS]%%DRIV.F $! Creates: GRPCKG.OLB (object-module library). $! Updates: $! 19-Oct-1998 D.Maden In DRIVERS directory, ensure that VTDRIV-VMS.F $! gets compiled rather than VTDRIV.F. $!---------------------------------------------------------------------- $ DELETE = "DELETE/NOLOG/NOCONFIRM" $ PURGE = "PURGE/NOLOG/NOCONFIRM" $! Different setup required for VAX and AXP. $! $ ON WARNING THEN GOTO VAX $ MACHINE=F$GETSYI("ARCH_NAME") $ IF MACHINE .EQS. "AXP" THEN GOTO AXP $ IF MACHINE .EQS. "Alpha" THEN GOTO AXP $ GOTO VAX $VAX: $ WRITE SYS$OUTPUT "OpenVMS VAX" $ FCOMPILE = "FORTRAN/NOWARN" $ CCOMPILE = "CC" $ GOTO START $AXP: $ WRITE SYS$OUTPUT "OpenVMS AXP" $ FCOMPILE = "FORTRAN/NOWARN/SEPARATE_COMPILATION" $ CCOMPILE = "CC/STANDARD=VAXC" $ GOTO START $START: $!---------------------------------------------------------------------- $ ON ERROR THEN EXIT $ PGPLOT = P1 $ SRC = PGPLOT - "]" + ".SRC]" $ VMS = PGPLOT - "]" + ".SYS_VMS]" $ DRV = PGPLOT - "]" + ".DRIVERS]" $ MOTIF = PGPLOT - "]" + ".DRIVERS.XMOTIF]" $ WSO = "WRITE SYS$OUTPUT" $! $! Create the object-module library. $! $ WSO "Creating object-module library" $ LIBRARY/CREATE=(BLOCKS:200)/LOG TEMP.OLB $! $! Compile GRPCKG and PGPLOT. $! $ WSO "Compiling PGPLOT library routines from ", SRC $! (Include files must be in current directory) $ COPY 'SRC'PGPLOT.INC,GRPCKG1.INC [] $!WSO "(Ignore messages about variables that were declared but not used)" $ COPY/CONCAT 'SRC'*.F TEMP.FOR $ FCOMPILE TEMP/NODEBUG $ LIBRARY/REPLACE TEMP TEMP $ DELETE TEMP.OBJ;*,TEMP.FOR;* $ WSO "Compiling VMS-specific routines" $ COPY/CONCAT 'VMS'*.F TEMP.FOR $ FCOMPILE TEMP/NODEBUG $ LIBRARY/REPLACE TEMP TEMP $ DELETE TEMP.OBJ;*,TEMP.FOR;* $CLOOP: $ FILE = F$SEARCH(VMS+"*.C") $ IF FILE .EQS. "" THEN GOTO ENDCLOOP $ FILEX = F$PARSE(FILE,,,"NAME","SYNTAX_ONLY") $ WSO FILEX $ CCOMPILE/NODEBUG 'FILE' $ LIBRARY/REPLACE TEMP 'FILEX'.OBJ $ DELETE 'FILEX'.OBJ;* $ GOTO CLOOP $ENDCLOOP: $ WSO "Compiling Fortran Device Handlers" $LOOP: $ FILE = F$SEARCH(DRV+"%%DRIV.F") $ IF FILE .EQS. "" THEN GOTO ENDLOOP $ FILEX = F$PARSE(FILE,,,"NAME","SYNTAX_ONLY") $ FILEXVMS = F$SEARCH(drv+filex+"-VMS.F", 2) $ if FILEXVMS .nes. "" $ THEN $ file = FILEXVMS $ filex = f$parse(file,,,"name","syntax_only") $ ENDIF $ WSO FILEX $ FCOMPILE/NODEBUG 'FILE' $ LIBRARY/REPLACE TEMP 'FILEX'.OBJ $ DELETE 'FILEX'.OBJ;* $ GOTO LOOP $ENDLOOP: $!------ Delete the following lines if you do not have a C compiler ---- $ WSO "Compiling /XWINDOW Device Handler" $ DEFINE/NOLOG X11 DECW$INCLUDE $ CCOMPILE 'DRV'xwdriv.c $ LIBRARY/REPLACE TEMP xwdriv.obj $ DELETE xwdriv.obj;* $ WSO "Compiling /XDISP Device Handler" $ DEFINE/NOLOG X11 DECW$INCLUDE $ CCOMPILE 'DRV'x2driv.c $ CCOMPILE 'DRV'figdisp_comm.c $ LIBRARY/REPLACE TEMP x2driv.obj,figdisp_comm.obj $ DELETE x2driv.obj;*,figdisp_comm.obj; $ WSO "Compiling /XMOTIF Device Handler stub" $ CCOMPILE 'DRV'xmdriv.c $ LIBRARY/REPLACE TEMP xmdriv.obj $ DELETE xmdriv.obj;* $!------ End delete ---------------------------------------------------- $ SET FILE/PROT=(O:RWED) PGPLOT.INC,GRPCKG1.INC $ DELETE PGPLOT.INC;*,GRPCKG1.INC;* $! $ RENAME TEMP.OLB GRPCKG.OLB $ SET FILE/PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) GRPCKG.OLB;* $ PURGE GRPCKG.OLB $! $! Compile the pgxwin_server $! $!------ Delete the following lines if you do not have a C compiler ---- $ WSO "Compiling PGXWIN_SERVER program for use with /XWINDOW" $ CCOMPILE 'DRV'pgxwin_server.c $ LINK/NOUSER pgxwin_server,sys$input:/opt sys$share:DECW$XLIBSHR.EXE/share $ DELETE pgxwin_server.obj;* $ SET FILE/PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) pgxwin_server.exe;* $ PURGE pgxwin_server.exe $!------ End delete ---------------------------------------------------- $ EXIT pgplot/sys_vms/grtrml.f010064400040640000322000000021320552456016700157230ustar00tjpcitmbr00000400000017 C*GRTRML -- get name of user's terminal (VMS) C+ SUBROUTINE GRTRML(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the device name of the user's terminal, if any. In VMS, the C name of the terminal is found by translating and expanding the C logical name TT. C C Arguments: C STRING : receives the terminal name, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 19-Jan-1988 C----------------------------------------------------------------------- INTEGER LIB$GETDVI INTEGER I, IER EXTERNAL DVI$_FULLDEVNAM C STRING = ' ' IER = LIB$GETDVI(%LOC(DVI$_FULLDEVNAM), , 'TT:', , 1 STRING, L) IF (IER.NE.1 .OR. L.LT.1 .OR. STRING.EQ.' ') THEN L = 0 STRING = ' ' ELSE DO 10 I=L,1,-1 L = I IF (STRING(I:I).NE.' ') GOTO 20 10 CONTINUE L = 0 20 CONTINUE END IF END pgplot/sys_vms/grtter.f010064400040640000322000000020470546005624700157260ustar00tjpcitmbr00000400000017 C*GRTTER -- test whether device is user's terminal (VMS) C+ SUBROUTINE GRTTER(STRING, SAME) CHARACTER*(*) STRING LOGICAL SAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C STRING : (input) the device name to be tested. C SAME : (output) .TRUE. is STRING contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 9-Feb-1988 C----------------------------------------------------------------------- INTEGER LIB$GETDVI INTEGER IER1, IER2, L1, L2 CHARACTER*255 DEV1, DEV2 EXTERNAL DVI$_FULLDEVNAM C IER1 = LIB$GETDVI(%LOC(DVI$_FULLDEVNAM), , STRING, , 1 DEV1, L1) IER2 = LIB$GETDVI(%LOC(DVI$_FULLDEVNAM), , 'TT:', , 1 DEV2, L2) SAME = (IER1.EQ.1) .AND. (IER2.EQ.1) .AND. 1 (L1.EQ.L2) .AND. (DEV1(:L1).EQ.DEV2(:L2)) END pgplot/sys_vms/gruser.f010064400040640000322000000016310546005624700157240ustar00tjpcitmbr00000400000017 C*GRUSER -- get user name (VMS) C+ SUBROUTINE GRUSER(STRING, L) CHARACTER*(*) STRING INTEGER L C C Return the name of the user running the program. C C Arguments: C STRING : receives user name, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. C-- C 19-Jan-1988 C----------------------------------------------------------------------- INTEGER LIB$GETJPI INTEGER I, IER, LENGTH EXTERNAL JPI$_USERNAME C STRING = ' ' IER = LIB$GETJPI(%LOC(JPI$_USERNAME),,,,STRING,LENGTH) L = MIN(LENGTH, LEN(STRING)) IF (L.LT.1 .OR. STRING.EQ.' ') THEN L = 0 STRING = ' ' ELSE DO 10 I=L,1,-1 L = I IF (STRING(I:I).NE.' ') GOTO 20 10 CONTINUE L = 0 20 CONTINUE END IF END pgplot/sys_vms/make_font.com010064400040640000322000000016200570561357300167120ustar00tjpcitmbr00000400000017$! Make the PGPLOT binary font file. $! Input files: [.FONTS]grfont.txt (ASCII font file) $! pgpack.f $! Creates: GRFONT.DAT (binary font file) $!---------------------------------------------------------------------- $ ON WARNING THEN EXIT $ PROC = P1 $ IF PROC.EQS."" THEN PROC = "[]" $ PGPLOT = F$PARSE(PROC,,,"DEVICE","SYNTAX_ONLY") + - F$PARSE(PROC,,,"DIRECTORY","SYNTAX_ONLY") $ SRC = PGPLOT - "]" + ".FONTS]" $ ECHO = "WRITE SYS$OUTPUT" $! $ ECHO "Compiling font utility program" $ FORTRAN 'SRC'PGPACK.F/NODEBUG/WARN=ALL $ LINK/NOUSER PGPACK,GRPSHR.OLB/LIB $! $ ECHO "Creating binary font file GRFONT.DAT" $ DEFINE/USER SYS$INPUT 'SRC'GRFONT.TXT $ RUN PGPACK $ DELETE/NOCONF/NOLOG PGPACK.OBJ;*,PGPACK.EXE;* $ set file/prot=(O:RWED) grfont.dat;* $ PURGE/NOCONF/NOLOG GRFONT.DAT $ set file/prot=(S:RWD,O:RWD,G:R,W:R) grfont.dat $! $ EXIT pgplot/sys_vms/logical.com010064400040640000322000000022250566674766100163770ustar00tjpcitmbr00000400000017$! Define logical names for PGPLOT. It is assumed that the PGPLOT $! directory is the current default directory. $!---------------------------------------------------------------------- $ PGPLOT = F$ENVIRONMENT("DEFAULT") $ DEF = "DEFINE/NOLOG" $! $ DEF PGPLOT_DIR 'PGPLOT' $ ! directory containing PGPLOT library. $ DEF PGPLOT_TYPE "PS" $ ! default device type, used if "/type" is $ ! omitted (example). $ DEF PGPLOT_DEV "/XSERV" $ ! default device spec, used if blank string $ ! specified in PGBEG (example). $! DEF PGPLOT_FONT PGPLOT_DIR:GRFONT.DAT $ ! location of binary font file, used at $ ! run-time. $! DEF PGPLOT_RGB PGPLOT_DIR:RGB.TXT $ ! location of color definition file. $ DEF GRPSHR PGPLOT_DIR:GRPSHR.EXE $ ! location of PGPLOT shareable image, used $ ! at run-time. $ DEF LNK$LIBRARY PGPLOT_DIR:GRPSHR.OLB $ ! location of symbol-table library, used $ ! when linking PGPLOT programs. $!DEF PGPLOT_BACKGROUND "slate grey" $ ! default background color (example). $!DEF PGPLOT_FOREGROUND "yellow" $ ! default foreground color (example). pgplot/sys_vms/makedoc.com010064400040640000322000000060350616060156400163500ustar00tjpcitmbr00000400000017$! The following extracts documentation from pgplot source files. $! $! This procedure assumes the current configuration's drivers.list is $! in the current default directory. $! $! The following files are created: $! $! pgplot.index - a listing of routine names and short descriptions, $! one routine per line $! pgplot.doc - documentation extracted from source files, $! one routine per page $! pgplot.hlp - VMS help file showing routines and drivers $ $ on error then $ goto abort $ on severe_error then $ goto abort $ on control_y then $ goto abort $ pgplot = p1 $ src = pgplot - "]" + ".src]" $ file_list = "''src'pg*.f" $ ff[0,8] = 12 $ tab[0,8] = 9 $ copy sys$input pgplot.hlp 1 PGPLOT PGPLOT GRAPHICS SUBROUTINE LIBRARY Version 5.1 PGPLOT is a Fortran subroutine package for drawing graphs on a variety of display devices. For more details, see the manual ``PGPLOT Graphics Subroutine Library'' available from T. J. Pearson (tjp@astro.caltech.edu). 2 Routines $ open/append hlp_file pgplot.hlp $ create pgplot.hlp3 $ open/append hlp3_file pgplot.hlp3 $ create pgplot.index $ open/append index_file pgplot.index $ create pgplot.doc $ open/append doc_file pgplot.doc $ next_file: $ file_name = f$search (file_list) $ if file_name .eqs. "" then $ goto last_file $ open/read src_file 'file_name' $ read src_file title $ if f$edit (f$extract (0, 2, title), "upcase") .nes. "C*" - then $ goto end_file $ write index_file f$extract (2, 255, title) $ write doc_file ff $ write doc_file title $ look_for_doc: $ read/end=end_file src_file line $ write doc_file line $ if f$edit (f$extract (0, 2, line), "upcase") .nes. "C+" - then $ goto look_for_doc $ write hlp_file " " + f$extract (2, 255, title) $ write hlp3_file "3 " + f$element (0, " ", f$extract (2, 255, title)) $ write hlp3_file " " + f$extract (2, 255, title) $ read_doc: $ read/end=no_end src_file line $ write doc_file line $ if f$edit (f$extract (0, 2, line), "upcase") .eqs. "C-" - then $ goto end_file $ write hlp3_file " " + f$extract (1, 255, line) $ goto read_doc $ $ no_end: $ write sys$output "No C- in ''file_name'" $ $ end_file: $ close src_file $ goto next_file $ $ last_file: $ close hlp_file $ close hlp3_file $ close index_file $ close doc_file $ append pgplot.hlp3 pgplot.hlp $ delete pgplot.hlp3;* $ $ open/read drivers_file drivers.list $ open/append hlp_file pgplot.hlp $ write hlp_file "2 Drivers" $ write hlp_file " The following drivers are supported on this system:" $ write hlp_file "" $ write hlp_file " File Code Description" $ open/read drivers_file drivers.list $ next_driver: $ read/end=last_driver drivers_file driver $ if f$extract (0, 1, driver) .nes. " " then $ goto next_driver $ len = f$locate (tab, driver) ! tab is end of line $ write hlp_file " " + f$extract (1, len-1, driver) $ goto next_driver $ last_driver: $ close hlp_file $ close drivers_file $ exit (1) $ $ abort: $ write sys$output file_name $ close src_file $ close drivers_file $ close hlp_file $ close hlp3_file $ close index_file $ close doc_file $ exit (0) umentation from pgplot source files. $! $! This procedure assumes the current configuration's drivers.list is $! in the current default directory. $! $! The following files are created: $! $! pgplot.index - a listing of routine names and short descriptions, $! one routine per line $! pgplot.doc - documentation extracted from source files, $! one routine per page $! pgplot.hlp - VMS help file showing routines and drivers $ $ on error then $ goto pgplot/sys_vms/newexec.com010064400040640000322000000073760566674766200164400ustar00tjpcitmbr00000400000017$ ver='F$VERIFY(0) $ SET NOON $ ECHO = "WRITE SYS$OUTPUT" $ ECHO "Creating device-dispatch routine GREXEC.F from DRIVERS.LIST" $! $! This command file deletes the existing GREXEC.F routine and $! then creates a new version that includes calls to all device $! handlers sepecified in file DRIVERS.LIST. $! $! modified 8/11/93 bht to check for existence of SYS$LIBRARY:UISSHR.EXE $! and SYS$LIBRARY:DECW$XLIBSHR.EXE before including windowing drivers $! $ ON control_y THEN GOTO Ex $! Delete any existing GREXEC.F routines (so as to not confuse things). $ IF F$SEARCH("GREXEC.F;*") .NES. "" THEN - $ DELETE/NOLOG/NOCONFIRM GREXEC.F;* $! $! Now scan the [.DRIVERS] directory for %%DRIVER.F routines and count $! them. $! $ NDEV=0 $ NAMES = "" $ UIS = F$SEARCH("SYS$LIBRARY:UISSHR.EXE") $ XLIB = F$SEARCH("SYS$LIBRARY:DECW$XLIBSHR.EXE") $ open list DRIVERS.LIST /read $ $ 40: read list line /end=50 $ line = f$edit(line,"COMPRESS,TRIM,UNCOMMENT,UPCASE") $ if line .eqs. "" then goto 40 $ name = f$element(0," ",line) $! for WSDRIVER check that SYS$LIBRARY:UISSHR.EXE is online $ IF F$EXTRACT(0,2,NAME) .eqs. "WS" .and. UIS .eqs. "" $ THEN $ ECHO "Rejecting WSDRIVER -- UIS is not installed" $ GOTO 40 $ ENDIF $! for XEDRIVER check that SYS$LIBRARY:DECW$XLIBSHR.EXE is online $ IF F$EXTRACT(0,2,NAME) .eqs. "XE" .and. XLIB .eqs. "" $ THEN $ ECHO "Rejecting XEDRIVER -- DECWindows is not installed" $ GOTO 40 $ ENDIF $ IF F$EXTRACT(0,2,NAME) .eqs. "X2" .and. XLIB .eqs. "" $ THEN $ ECHO "Rejecting X2DRIVER -- DECWindows is not installed" $ GOTO 40 $ ENDIF $ NDEV = NDEV+1 $ DRIVER'NDEV' = F$EXTRACT(0,6,NAME) $ CODE'NDEV' = F$ELEMENT(1," ",line) $ NAMES = NAMES + "," + F$EXTRACT(0,2,DRIVER'ndev') $ goto 40 $ 50: close list $! $! Create the dispatch routine. Open file and write header info. $! $ Make: $ ECHO NDEV," device handlers found:" $ NAMES = NAMES - "," + "." $ ECHO NAMES $ OPEN/WRITE TMP TMP.F $ WRT = "WRITE TMP" $ WRT "C*GREXEC -- PGPLOT device handler dispatch routine" $ WRT "C+ $ WRT " SUBROUTINE GREXEC(IDEV,IFUNC,RBUF,NBUF,CHR,LCHR)" $ WRT " INTEGER IDEV, IFUNC, NBUF, LCHR" $ WRT " REAL RBUF(*)" $ WRT " CHARACTER*(*) CHR" $ WRT "C" $ WRT "C DO NOT MODIFY THIS ROUTINE." $ WRT "C You should always create a new version by re-executing" $ WRT "C the command file NEWEXEC.COM." $ WRT "C---" $ WRT " INTEGER NDEV $ WRT " PARAMETER (NDEV=",NDEV,")" $ WRT " CHARACTER*10 MSG" $ WRT "C---" $! $! Now construct the computed GOTO statement. $! $ ICNT=0 $ CBUF=" GOTO(" $ Cgoto: $ ICNT=ICNT+1 $ IF ICNT .GT. NDEV THEN GOTO Done $ CBUF=CBUF+"''ICNT'" $ IF ICNT.NE.NDEV THEN CBUF=CBUF+"," $ IF F$LENGTH(CBUF).LT.60 THEN GOTO Cgoto $ WRT CBUF $ CBUF=" : " $ GOTO Cgoto $! $ Done: $ WRT CBUF+") IDEV" $ WRT " IF (IDEV.EQ.0) THEN" $ WRT " RBUF(1) = NDEV" $ WRT " NBUF = 1" $ WRT " ELSE" $ WRT " WRITE (MSG,'(I10)') IDEV" $ WRT " CALL GRQUIT('Unknown device code in GREXEC: '//MSG)" $ WRT " END IF" $ WRT " RETURN" $ WRT "C---" $! $! Now add lines that actually call the device handlers. $! $ ICNT=0 $ Mloop: $ ICNT=ICNT+1 $ IF ICNT.GT.NDEV THEN GOTO Last $ IF (CODE'ICNT' .GT. 0) $ THEN $ WRT f$fao("!5UL CALL !AS(IFUNC,RBUF,NBUF,CHR,LCHR,!AS)", ICNT, - DRIVER'ICNT', CODE'ICNT') $ ELSE $ WRT f$fao("!5UL CALL !AS(IFUNC,RBUF,NBUF,CHR,LCHR)", ICNT, - DRIVER'ICNT') $ ENDIF $ WRT " RETURN" $ GOTO Mloop $! $ Last: $ WRT "C" $ WRT " END" $ CLOSE TMP $ RENAME TMP.F GREXEC.F $ FILE = F$SEARCH("GREXEC.F") $ ECHO FILE," created" $ FORTRAN/WARN=ALL/STAND=ALL 'FILE' $ LIBRARY/REPLACE GRPCKG.OLB GREXEC.OBJ $ SET FILE/PROT=(O:RWED,S:RWED) GREXEC.OBJ;* $ DELETE/NOCONFIRM GREXEC.OBJ;* $ Ex: $ IF ver THEN SET VERIFY pgplot/sys_vms/setup_pgdisp.com010064400040640000322000000001600566674766200174700ustar00tjpcitmbr00000400000017$ PGDISP == "$PERKIN2:[TJP.PGPLOT]PGDISP" $ SPAWN/NOWAIT/INPUT=NL: PGDISP -line 64 $ DEFINE PGPLOT_DEV "/XDISP" pgplot/sys_vms/make_demos.com010064400040640000322000000022460570560170100170460ustar00tjpcitmbr00000400000017$! [VAX/VMS DCL] To compile PGPLOT demo programs. $! Usage: argument 1 is the PGPOT distribution directory: the source $! code for the demo programs should be in the [.EXAMPLES] subdirectory $! of this directory, with names PGDEM*.F. The executable programs are $! created in the current directory. $!---------------------------------------------------------------------- $ ON WARNING THEN EXIT $ PROC = P1 $ IF PROC.EQS."" THEN PROC = "[]" $ PGPLOT = F$PARSE(PROC,,,"DEVICE","SYNTAX_ONLY") + - F$PARSE(PROC,,,"DIRECTORY","SYNTAX_ONLY") $ SRC = PGPLOT - "]" + ".EXAMPLES]" $ ECHO = "WRITE SYS$OUTPUT" $ $ ECHO "Compiling demonstration programs" $ DEMOS = SRC + "PGDEM*.F" $ LOOP: $ FILE = F$SEARCH(DEMOS,1) $ IF FILE .EQS. "" THEN GOTO ENDLOOP $ FILE = F$PARSE(FILE,,,"NAME","SYNTAX_ONLY") $ CALL COMPILE 'FILE' $ GOTO LOOP $ ENDLOOP: $ EXIT $! $ COMPILE: SUBROUTINE $ ECHO P1 $ FFILE = SRC + P1 + ".F" $ FORTRAN/NOWARN/STANDARD=ALL 'FFILE' $ LINK/NOUSER 'P1'.obj,PGPLOT_DIR:GRPSHR.OLB/LIB $ DELETE/NOCONFIRM/NOLOG 'P1'.obj;* $ SET PROTECTION=(S:RWED,O:RWED,G:RE,W:RE) 'P1'.exe $ PURGE/NOLOG/NOCONFIRM 'P1'.exe $ ENDSUBROUTINE pgplot/sys_vms/grgmem.f010064400040640000322000000013110563172356000156650ustar00tjpcitmbr00000400000017C Fortran callable memory allocator (OpenVMS) C C Called as : C ier = grgmem (size,pointer) C C where : size is an integer size of memory to allocate C pointer is an integer to return the pointer into INTEGER FUNCTION GRGMEM(SIZE, POINTER) INTEGER SIZE, POINTER INTEGER LIB$GET_VM GRGMEM = LIB$GET_VM(SIZE, POINTER) END C Fortran callable memory deallocator C C Called as : C ier = grfmem (size,pointer) C C where : size is an integer size of memory to deallocate (not used) C pointer is an integer that contains the pointer INTEGER FUNCTION GRFMEM(SIZE, POINTER) INTEGER SIZE, POINTER INTEGER LIB$FREE_VM GRFMEM = LIB$FREE_VM(SIZE, POINTER) END pgplot/sys_vms/motif_bug.txt010064400040640000322000000237000565375407000167660ustar00tjpcitmbr00000400000017There are bugs in DECwindows Motif 1.2 (but not 1.1) that affect the PGPLOT driver xedriver.f (Fortran DECwindows driver). The following note describes the bugs and a workaround. A better solution is to use the new C X-window driver (xwdriv.c) if you have a DEC C compiler. ------------------------------------------------------------------------ Date: Sun, 23 Oct 1994 17:13:56 EDT From: Rachael Padman +44 (223) 337310 To: tjp@PERKIN.CALTECH.EDU Message-ID: <00986621.ED91DF53.1@mrao.cam.ac.uk> Subject: RE: PGPLOT under VMS 6.1 /Motif 1.2 Hello Tim, Just to follow up on the problem I described earlier. There is indeed a (or even many) problems with Motif 1.2., as has become clear from various comments on vmsnet.alpha and related newsgroups. The problems with XEDRIVER in your V4.9H show up as: + Failure to create a bitmap from the LOGO data + Failure to define the ICON name + Failure to create an image in X$CREATE_IMAGE. There are others, but don't seem to be used in your driver, and of the above only the last actually matters. I have held off setting up a call to DEC until I had a simple way to demonstrate the problem, but I have now received a replacement routine for X$CREATE_IMAGE (appended) which does work, so I have set up a call with DEC and we will see what happens --- I will keep you informed. In the meantime, in case it is of use to you, here is the new code: Regards Rachael --------------------------------------------------------------- From: MX%"bill@office.ab.umd.edu" 21-OCT-1994 15:29:36.96 To: MX%"rachael@mrao.cam.ac.uk" CC: Subj: RE: bugs in xlib >I saw your posting in vmsnet.misc at the end of August re bugs in >xlib under Motif 1.2 (on AXP?). I have several applications which no >longer run correctly now that I have upgraded, and I believe these >bugs to be the cause. > >Specifically, part of a graphics package that uses x$create_image and >x$put_image seems to be broken. Following your comments, I tried replacing >these with calls to xCreateImage and xPutImage, and with a bit of fiddling >around with %VAL etc got a program which didn't crash, but which also failed >to display a greyscale. > >Now my question is: Do you have any experience or knowledge yourself that >the two DEC routines might be broken? I am thinking about putting together a >simple application to demonstrate the problem, and assuming it is still >there, then sending it to DEC, but I don't want to do all this if everyone >else already knows about it. Of course, if you not only know about such a >problem, but also have a fix for it, that would be very gratefully received. > >Many thanks for your time, >Rachael Padman Rachael, I had simillar problems with FORTRAN-based X11 applications after installing MOTIF 1.2. My general solution has been to either rewrite in C or to call the C version of the X function (like you attempted to do - not always a trivial task due to C calling conventions). So far I've only found two functions that don't work, and I have workarounds for both that don't require writing C code or calling C functions... The functions are: X$CREATE_IMAGE and X$LOAD_QUERY_FONT both of these functions return '0' no matter what you feed them. Here are the workaround I have found... X$LOAD_QUERY_FONT can be replaced by X$LOAD_FONT followed by X$QUERY_FONT - this works just fine. X$CREATE_IMAGE, on the other hand, is totally broken... here's a snippet of code to take care of it (works on AXP and VAX with MOTIF 1.2 - Note that this is not guaranteed to work with later versions of X11). Just replace all instances of X$CREATE_IMAGE in your code with HACK$CREATE_IMAGE and your problem should be solved. I never did figure out how to successfully call XCreateImage() from FORTRAN, but then again I didn't try very hard. integer*4 function hack$create_image(display, visual, depth, format, 1 offset, data, width, height, bitmap_pad, bytes_per_line, 1 image) implicit none include 'sys$library:decw$xlibdef.for' integer*4 display,depth,format,offset,width,height,bitmap_pad, 1 bytes_per_line byte data(*) record /x$visual/ visual record /x$image/ image image.x$l_imag_width = width image.x$l_imag_height = height image.x$l_imag_xoffset = offset image.x$l_imag_format = format image.x$a_imag_data=%loc(data) image.x$l_imag_byte_order=0 image.x$l_imag_bitmap_unit=32 image.x$l_imag_bitmap_bit_order=0 image.x$l_imag_bitmap_pad=bitmap_pad image.x$l_imag_depth=depth if (bytes_per_line .eq. 0) then image.x$l_imag_bytes_per_line=width else image.x$l_imag_bytes_per_line=bytes_per_line endif image.x$l_imag_bits_per_pixel=8 image.x$l_imag_red_mask = -1 image.x$l_imag_green_mask = -1 image.x$l_imag_blue_mask = -1 hack$create_image=1 return end -- +--------------------------------------+-------------------------------------+ | William P. Bame | Ground: William P. Bame | | internet: bill@office.ab.umd.edu | UMMS/Shock Trauma | | bbame@achi1.ab.umd.edu | 22 South Greene Street | | AT&T : [Work] (410) 328-3062 | Baltimore, MD 21201 | | CIS : 71620,425 | Room: T1R55 | +--------------------------------------+-------------------------------------+ From: ST%"rachael@mrao.cam.ac.uk" 27-OCT-1994 06:00:08.62 To: TJP CC: Subj: FWD: X$CREATE_IMAGE workaround example Received: from ppsw3.cam.ac.uk by Deimos.Caltech.Edu with INTERNET ; Thu, 27 Oct 94 05:59:56 PDT Received: from MRAO.ra.phy.cam.ac.uk by mauve.csi.cam.ac.uk with SMTP-CAM (PP-7.1) as ppsw.cam.ac.uk; Thu, 27 Oct 1994 12:54:18 +0100 Received: by mrao.cam.ac.uk (MX V4.0 VAX) id 1; Thu, 27 Oct 1994 12:57:13 BST Date: Thu, 27 Oct 1994 12:57:19 EDT From: Rachael Padman +44 (223) 337310 To: tjp@perkin.caltech.edu Message-ID: <00986922.BDE4FA66.1@mrao.cam.ac.uk> Subject: FWD: X$CREATE_IMAGE workaround example Hi Tim, thanks for your reply. I look forward to the next version of PGPLOT. In the meantime, for your information, here is the response from DEC. So -- they are aware of the problem, and I guess we are just waiting for the patch. I will leave it here unless anything particularly relevant occurs. Regards Rachael ------------------------------------------ To: rachael@mrao.cam.ac.uk CC: if@uvo.dec.com Subject: X$CREATE_IMAGE workaround example Date: Thu, 27 Oct 94 12:38:18 +0000 From: if@uvo.dec.com X-Mts: smtp Hi, Here's the example code we discussed. I have been unable to progress my enquiries into the availability of a patch for the problem. I'll keep you posted as soon as I hear of anything. regards Ian program text_X implicit none include 'sys$library:decw$xlibdef.for/nolist' external XCreateImage record /x$visual/visual record /x$image/img integer*4 display,func,window,screen,status,pimg integer*4 XCreateImage integer*1 tablo(640,512) display = x$open_display('decw$display') status = x$synchronize(display,1,func) screen = x$default_screen_of_display(display) window = x$create_simple_window(display, 1 x$root_window_of_screen(screen),300,300,640,512,5, 1 x$white_pixel_of_screen(screen), 1 x$black_pixel_of_screen(screen)) call x$default_visual_of_screen(screen,visual) status = x$create_image(display,visual,8,x$c_z_pixmap,0,tablo,640,512, 1 640,img) c The img structure is filled in with 0 in motif v1.2 c c Workaround: Call the mit-c binding routine pimg = XCreateImage(%val(display),visual,%val(8),%val(x$c_z_pixmap), 1 %val(0),tablo,%val(640),%val(512),%val(8), 1 %val(640)) CALL COPY_IMAGE( img, %VAL(pimg) ) end C Used with workaround to copy from pointer to structure SUBROUTINE COPY_IMAGE( TARGET, SOURCE ) IMPLICIT NONE INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF/NOLIST' RECORD /X$IMAGE/ TARGET RECORD /X$IMAGE/ SOURCE TARGET = SOURCE RETURN END pgplot/sys_vms/grfileio.c010064400040640000322000000124550577136042200162160ustar00tjpcitmbr00000400000017/*GRFILEIO -- Fast low-level UNIX I/O routines * + * * GRFILEIO is a set of functions that makes fast, low-level Unix I/O routines * available to a Fortran program. * *------- * 2-Dec-92 - fastio.c: John L. Lillibridge, NOAA/NOS/OES Geosciences Lab * 11-Nov-93 - Addition of seekf and warning by Remko Scharroo, DUT/SSR&T * 17-May-94 - Nice manual * 13-Oct-94 - Bits not required by PGPLOT stripped out; routine names * changed [TJP]. * 09-Nov-94 - Tidied and ported to Cray [mcs] (untested). * 10-Nov-94 - Added GRFCH() routine to write FORTRAN CHARACTER sub-strings. * 19-Jun-95 - File name "-" means stdout. *------- */ #include #include #ifdef VMS #include unixio #include file #include descrip #else #include #include #include #endif #ifdef PG_PPU #define GROFIL grofil_ #define GRWFIL grwfil_ #define GRCFIL grcfil_ #define GRWFCH grwfch_ #else #define GROFIL grofil #define GRWFIL grwfil #define GRCFIL grcfil #define GRWFCH grwfch #endif /* **&GROFIL -- Open file for writing with GRFILEIO *+ * FUNCTION GROFIL (FNAME) * INTEGER GROFIL * CHARACTER*(*) FNAME * * Opens file FNAME for writing. * GROFIL returns the file descriptor for use in subsequent calls to * grwfil or grcfil. If GROFIL is negative, an error occurred while * opening the file. * ** * Usage: * * FD = GROFIL ('output_file') * CALL GRWFIL (FD, 4, ARRAY) * * Arguments: * FNAME (input) : File name of the input or output file * GROFIL (output) : Contains the file descriptor on return. If GROFIL < 0 * an error occurred while opening the file. *- */ #ifdef VMS int GROFIL(struct dsc$descriptor_s *chrdsc) { char *name = chrdsc->dsc$a_pointer; int slen = chrdsc->dsc$w_length; #else int GROFIL(fname, fname_len) char *fname; int fname_len; { char *name = fname; /* C pointer to FORTRAN string */ int slen = fname_len; /* Length of the FORTRAN string */ #endif char *buff=0; /* Dynamically allocated copy of name[] */ int fd = -1; /* File descriptor to be returned */ /* * Determine how long the FORTRAN string is by searching for the last * non-blank character in the string. */ while(slen>0 && name[slen-1]==' ') slen--; /* * Dynamically allocate a buffer to copy the FORTRAN string into. */ buff = (char *) malloc((slen+1) * sizeof(char)); if(buff) { /* * Make a C string copy of the FORTRAN string. */ strncpy(buff, name, slen); buff[slen] = '\0'; /* * Check for stdout. */ if (slen == 1 && buff[0] == '-') { fd = 1; } else { /* * Open the file and return its descriptor. */ fd = open(buff, O_WRONLY | O_CREAT | O_TRUNC, 0); } free(buff); } else { fprintf(stderr, "grofil: Insufficient memory\n"); }; return fd; } /* **&GRCFIL -- Close file from GRFILEIO access *+ * FUNCTION GRCFIL (FD) * INTEGER GRCFIL (FD) * * Closes the file with descriptor FD from GRFILEIO access. GRCFIL returns * 0 when properly closed. Otherwise, use PERRORF to report the error. * * Usage: * IOS = GRCFIL (FD) * or: * CALL GRCFIL (FD) * * In the last case the return code is ignored. * * Arguments: * FD (input) : File descriptor returned by GROFIL. * GRCFIL (output) : Error code or 0 on proper closing. *- */ int GRCFIL(fd) int *fd; { if ((*fd) == 1) { return 0; } else { return close(*fd); } } /* **&GRWFIL -- GRFILEIO write routine *+ * FUNCTION GRWFIL (FD, NBYTE, BUFFER) * INTEGER FD, NBYTE, GRWFIL * BYTE BUFFER(NBYTE) * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call. The array BUFFER contains the data that has * to be written, but can (of course) also be associated with any other * string, scalar, or n-dimensional array. * The function returns the number of bytes actually written in GRWFIL. If * GRWFIL < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * NBYTE (input) : Number of bytes to be written * BUFFER (input) : Buffer containing the bytes that have to be written * GRWFIL (output) : Number of bytes written, or (if negative) error code. *- */ int GRWFIL(fd, nbytes, buf) int *fd, *nbytes; char *buf; { return write(*fd, (void *) buf, *nbytes); } /* **&GRWFCH -- GRFILEIO write FORTRAN character STRING routine *+ * FUNCTION GRWFCH (FD, STRING) * INTEGER FD, GRWFCH * CHARACTER*(*) STRING * * Writes NBYTE bytes into the file associated by descriptor FD (which is * returned by the GROFIL call). The string STRING contains the data that has * to be written. * The function returns the number of bytes actually written in GRWFCH. If * GRWFCH < 0, a write error occurred. * * Arguments: * FD (input) : File descriptor returned by GROFIL * STRING (input) : String containing the characterst to be written * GRWFCH (output) : Number of bytes written, or (if negative) error code. *- */ #ifdef VMS int GRWFCH(int *fd, struct dsc$descriptor_s *chrdsc) { char *buf = chrdsc->dsc$a_pointer; int buf_len = chrdsc->dsc$w_length; return write(*fd, (void *) buf, buf_len); } #else int GRWFCH(fd, buf, buf_len) int *fd; char *buf; int buf_len; { return write(*fd, (void *) buf, buf_len); } #endif pgplot/sys_vms/make_pgdisp.com010064400040640000322000000120370607305362600172320ustar00tjpcitmbr00000400000017$! DCL command procedure to compile PGDISP for OpenVMS VAX and AXP $!---------------------------------------------------------------------- $! PGDISP is a display server program for Xwindows. Start up PGDISP $! to put its window on your X server. Then send PGPLOT output to it $! by specifying device "/XDISP". $! $! PGDISP is best run as a subprocess. To specify command-line options, $! define PGDISP as a "foreign command", and then spawn a process to run $! it, e.g., $! $ PGDISP == "$ECC1:[TJP.PGPLOT]PGDISP" $! (substitute the correct disk and directory, but keep the $ sign) $! $ SPAWN/NOWAIT/INPUT=NL: PGDISP -line 64 $! To set the PGPLOT default device to be PGDISP: $! $ DEFINE PGPLOT_DEV "/XDISP" $! $! The object and executable files are placed in the current default $! directory. $! $! Ignore the following messages from the linker: $! %LINK-W-NUDFSYMS, 7 undefined symbols: $! %LINK-I-UDFSYM, COMPOSITEOBJECTCLASS $! %LINK-I-UDFSYM, COMPOSITEWIDGETCLASS $! %LINK-I-UDFSYM, CONSTRAINTWIDGETCLASS $! %LINK-I-UDFSYM, OBJECTCLASS $! %LINK-I-UDFSYM, RECTOBJCLASS $! %LINK-I-UDFSYM, WIDGETCLASS $! %LINK-I-UDFSYM, WINDOWOBJCLASS $!---------------------------------------------------------------------- $ DELETE = "DELETE/NOLOG/NOCONFIRM" $ PURGE = "PURGE/NOLOG/NOCONFIRM" $ ECHO = "WRITE SYS$OUTPUT" $! $! Check for VMS or AXP $! $ ON WARNING THEN GOTO VAX $ MACHINE=F$GETSYI("ARCH_NAME") $ IF MACHINE .EQS. "AXP" THEN GOTO AXP $ IF MACHINE .EQS. "Alpha" THEN GOTO AXP $ GOTO VAX $VAX: $! $! Hardwire in MACHINE as VAX in case we got here from the warning line $! above since old versions of VMS won't support the ARCH_NAME field to $! F$GETSYI and this will mess up the link statement below. $! $ MACHINE="VAX" $ ECHO "Compiling PGDISP server program for OpenVMS VAX" $! $! Check that necessary libraries exist $! $ XLIB = F$SEARCH("SYS$SHARE:DECW$XLIBSHR.EXE") $ CRTL = F$SEARCH("SYS$SHARE:VAXCRTL.EXE") $ IF XLIB .EQS. "" $ THEN $ ECHO "DECW$XLIBSHR not found: PGDISP cannot be compiled" $ EXIT $ ENDIF $ IF CRTL .EQS. "" $ THEN $ ECHO "VAXCRTL not found: PGDISP cannot be compiled" $ EXIT $ ENDIF $ CCOMPILE = "CC" $ GOTO START $AXP: $ ECHO "Compiling PGDISP server program for OpenVMS AXP" $! $! Check that necessary libraries exist $! $ XLIB = F$SEARCH("SYS$SHARE:DECW$XLIBSHR.EXE") $ CRTL = F$SEARCH("SYS$SHARE:DECC$SHR.EXE") $ IF XLIB .EQS. "" $ THEN $ ECHO "DECW$XLIBSHR not found: PGDISP cannot be compiled" $ EXIT $ ENDIF $ IF CRTL .EQS. "" $ THEN $ ECHO "VAXCRTL not found: PGDISP cannot be compiled" $ EXIT $ ENDIF $ CCOMPILE = "CC/STANDARD=VAXC" $ GOTO START $START: $ SET NOON $! $! The source code is found in directory with logical name SRC, defined $! as follows (change this line for your installation): $! $ SRC = "[.PGDISPD]" $ IF P1 .NES. "" THEN SRC = P1 - "]" + ".PGDISPD]" $! $! Xwindow include files are in the following directory: $! $ DEFINE/NOLOG X11 DECW$INCLUDE $ DEFINE/NOLOG SYS SYS$LIBRARY $ DEFINE/NOLOG NETINET SYS$LIBRARY $! $! Compile: $! $ CCOMPILE /OBJECT=pg_cleanup.obj /define=PGDISP 'SRC'cleanup.c $ CCOMPILE 'SRC'pgdisp.c $ CCOMPILE /OBJECT=pg_figcurs.obj /define=PGDISP 'SRC'figcurs.c $ CCOMPILE /OBJECT=pg_getdata.obj /define=PGDISP 'SRC'getdata.c $ CCOMPILE /OBJECT=pg_getvisuals.obj /define=PGDISP 'SRC'getvisuals.c $ CCOMPILE /OBJECT=pg_handlexevent.obj /define=PGDISP 'SRC'handlexevent.c $ CCOMPILE /OBJECT=pg_proccom.obj /define=PGDISP 'SRC'proccom.c $ CCOMPILE /OBJECT=pg_resdb.obj /define=PGDISP 'SRC'resdb.c $ CCOMPILE 'SRC'exposelgwin.c $ CCOMPILE 'SRC'getcolors.c $ CCOMPILE 'SRC'initlgluts.c $ CCOMPILE 'SRC'initlgwin.c $ CCOMPILE 'SRC'initlock.c $ CCOMPILE 'SRC'initwmattr.c $ CCOMPILE 'SRC'mainloop.c $ CCOMPILE 'SRC'ntoh.c $ CCOMPILE 'SRC'resizelgwin.c $ CCOMPILE 'SRC'returnbuf.c $ CCOMPILE 'SRC'waitevent.c $ CCOMPILE 'SRC'updatelgtitle.c $! $! Link: $! $ IF MACHINE .EQS. "VAX" $ THEN $ LINK/NOUSER/EXEC=pgdisp.exe pgdisp, pg_cleanup, pg_figcurs, pg_getdata, - pg_getvisuals, pg_handlexevent, pg_proccom, pg_resdb, exposelgwin, - getcolors, initlgluts, initlgwin, initlock, initwmattr, mainloop, ntoh,- resizelgwin, returnbuf, waitevent, updatelgtitle, SYS$INPUT:/opt SYS$SHARE:VAXCRTL.EXE/SHARE SYS$SHARE:DECW$XLIBSHR.EXE/SHARE $ ELSE $ LINK/NOUSER/EXEC=pgdisp.exe pgdisp, pg_cleanup, pg_figcurs, pg_getdata, - pg_getvisuals, pg_handlexevent, pg_proccom, pg_resdb, exposelgwin, - getcolors, initlgluts, initlgwin, initlock, initwmattr, mainloop, ntoh,- resizelgwin, returnbuf, waitevent, updatelgtitle, SYS$INPUT:/opt SYS$SHARE:DECW$XLIBSHR.EXE/SHARE $ ENDIF $! $! Remove intermediate files: $! $ DELETE pgdisp.obj;*, pg_cleanup.obj;*, pg_figcurs.obj;*,- pg_getdata.obj;*, pg_getvisuals.obj;*, pg_handlexevent.obj;*,- pg_proccom.obj;*, pg_resdb.obj;*, exposelgwin.obj;*, getcolors.obj;*,- initlgluts.obj;*, initlgwin.obj;*, initlock.obj;*, initwmattr.obj;*,- mainloop.obj;*, ntoh.obj;*, resizelgwin.obj;*, returnbuf.obj;*,- waitevent.obj;*, updatelgtitle.obj;* $ PURGE pgdisp.exe $ SET FILE/PROT=(S:RWED,O:RWED,G:RE,W:RE) pgdisp.exe $! $ EXIT re in MACHINE as VAX in case we got here from the warning line $! above since old versions of VMS won't support the ARCH_NAME field to $! F$GETSYI and this will mess up the link statement below. $! $ MACHINE="VAX" $ ECHO "Compiling PGDISP server program for OpenVMS VAX" $! $! Check that necessary libraries exist $! $ XLIB = F$SEARCH("SYS$SHARE:DECW$XLIBSHR.EXE") $ CRTL = F$SEARCH("SYS$SHARE:VAXCRTL.EXE") $ IF XLIB .EQS. "" $ THEN $ ECHO "DECW$XLIBSHR not found: PGDISP cpgplot/sys_vms/aaaread.me010064400040640000322000000016660615363542300161560ustar00tjpcitmbr00000400000017pgplot/sys_vms The files in this directory are for use with OpenVMS VAX and OpenVMS Alpha (AXP). Consult the installation instructions for more information. Note: you will need both a Fortran compiler and a C compiler. If you do not have a C compiler, you will not be able to install some of the device drivers, notably the X-windows driver. You will need to edit file compile.com to exclude these drivers (see comments in the file). The various versions of the DEC C compilers are not identical. If you have trouble compiling PGPLOT C files with your compiler on a VMS/VAX system, try changing the definition $ CCOMPILE = "CC" to $ CCOMPILE = "CC/STANDARD=VAXC" This occurs in files compile.com, make_pgdisp.com, and make_pgmdemo.com. (The last two are only used if you choose to install PGDISP/X2DRIV or Motif support/XMDRIV, respectively.) Tim Pearson 31 May 1996 ------------------------------------------------------------------------ pgplot/sys_vms/make_pgmdemo.com010064400040640000322000000045230613351126400173670ustar00tjpcitmbr00000400000017$! DCL command procedure to compile Motif demo program for PGPLOT for $! OpenVMS VAX and AXP $!---------------------------------------------------------------------- $ DELETE = "DELETE/NOLOG/NOCONFIRM" $ PURGE = "PURGE/NOLOG/NOCONFIRM" $ ON WARNING THEN GOTO VAX $ MACHINE=F$GETSYI("ARCH_NAME") $ IF MACHINE .EQS. "AXP" THEN GOTO AXP $ IF MACHINE .EQS. "Alpha" THEN GOTO AXP $ GOTO VAX $VAX: $ WRITE SYS$OUTPUT "OpenVMS VAX" $ FCOMPILE = "FORTRAN/NOWARN" $ CCOMPILE = "CC" $ GOTO START $AXP: $ WRITE SYS$OUTPUT "OpenVMS AXP" $ FCOMPILE = "FORTRAN/NOWARN/SEPARATE_COMPILATION" $ CCOMPILE = "CC/STANDARD=VAXC" $ GOTO START $START: $! $ ON WARNING THEN EXIT $ PROC = P1 $ IF PROC.EQS."" THEN PROC = "[]" $ PGPLOT = F$PARSE(PROC,,,"DEVICE","SYNTAX_ONLY") + - F$PARSE(PROC,,,"DIRECTORY","SYNTAX_ONLY") $ DRV = PGPLOT - "]" + ".DRIVERS]" $ XMOTIF = PGPLOT - "]" + ".DRIVERS.XMOTIF]" $ SRC = PGPLOT - "]" + ".SRC]" $ WSO = "WRITE SYS$OUTPUT" $! $ IF F$SEARCH("cpgplot.h") .EQS. "" $ THEN $ WSO "Install CPG first!" $ EXIT $ ENDIF $! $ XMOTIF12 = F$SEARCH("SYS$SHARE:DECW$XMLIBSHR12.EXE") $ XMOTIF11 = F$SEARCH("SYS$SHARE:DECW$XMLIBSHR.EXE") $ IF XMOTIF12.NES."" $ THEN $ WSO "Using DECwindows MOTIF 1.2 libraries" $ CREATE PGMOTIF.OPT pgplot_dir:PGXWIN.OBJ pgplot_dir:XMPGPLOT.OBJ pgplot_dir:CPGPLOT.OLB/lib pgplot_dir:GRPCKG.OLB/lib SYS$SHARE:DECW$XMLIBSHR12.EXE/share SYS$SHARE:DECW$XTLIBSHRR5.EXE/share SYS$SHARE:DECW$XLIBSHR.EXE/share SYS$SHARE:DECC$SHR.EXE/share $ ELSE IF XMOTIF11.NES."" $ THEN $ WSO "Using DECwindows MOTIF 1.1 libraries" $ CREATE PGMOTIF.OPT pgplot_dir:PGXWIN.OBJ pgplot_dir:XMPGPLOT.OBJ pgplot_dir:CPGPLOT.OLB/lib pgplot_dir:GRPCKG.OLB/lib SYS$SHARE:DECW$XMLIBSHR.EXE/share SYS$SHARE:DECW$XTSHR.EXE/share SYS$SHARE:DECW$XLIBSHR.EXE/share SYS$SHARE:DECC$SHR.EXE/share $ ELSE $ WSO "MOTIF is not installed on this system" $ EXIT $ ENDIF $ ENDIF $! $ WSO "Compiling /XMOTIF Device Handler" $ FILE = F$SEARCH("XM:XM.H") $ IF FILE .EQS. "" $ THEN $ WSO "MOTIF header files are not installed on this system" $ ELSE $ 'CCOMPILE' 'DRV'pgxwin.c $ 'CCOMPILE' 'XMOTIF'xmpgplot.c /INCLUDE_DIRECT='DRV' $ ENDIF $! $ COPY 'XMOTIF'xmpgplot.h [] $ 'CCOMPILE' 'XMOTIF'PGMDEMO.C /INCLUDE=[] $ LINK PGMDEMO, PGMOTIF.OPT/OPT $ DELETE PGMDEMO.OBJ;* $ PURGE PGMDEMO.EXE $! $ EXIT: EXIT pgplot/makemake010075500040640000322000000662010671367307700142600ustar00tjpcitmbr00000400000017#!/bin/sh # # Procedure to create PGPLOT makefile # #----------------------------------------------------------------------- if test $# -lt 1; then echo "Usage: makemake pgplot_dist operating_system configuration" echo " pgplot_dist = The top level directory of the PGPLOT distribution." echo " (ie. The directory in which makemake was found!)." echo " operating_system = Operating system name (omit this to get a list)." echo " configuration = Optional if there is only one for the specified OS." echo " (Otherwise you will be presented with a list)" exit 1 fi SRC=$1 # Check for the required PGPLOT sub-directories. for dir in drivers examples fonts src sys ; do if test ! -d $SRC/$dir; then echo "Failed to find required PGPLOT directory $SRC/$dir" echo "The first argument must name the PGPLOT root directory." exit 1 fi done # The second argument is the name of the target operating system. if test $# -ge 2 -a -d $SRC/sys_$2; then OS=$2 SYSDIR=$SRC/sys_$OS else echo 'The second argument must be one of the following operating systems:' cd $SRC echo " `echo sys_* | sed 's/sys_//g'`" exit 1 fi if test -r $SYSDIR/aaaread.me; then echo 'For additional information, read file' $SYSDIR/aaaread.me fi # The third argument is optional if there is only a single configuration # but must be specified otherwise. if test $# -ge 3 -a -f "$SYSDIR/$3.conf"; then CONFIG="$SYSDIR/$3.conf" elif test $# -lt 3 -a -f ./local.conf; then CONFIG="./local.conf" elif test $# -lt 3 -a -f "`ls $SYSDIR/*.conf`"; then CONFIG="`ls $SYSDIR/*.conf`" else cd $SRC/sys_$OS config_files=`echo *.conf` if test "$config_files" = '*.conf'; then echo "No configuration files found for $OS" else echo "The third argument for $OS must be one of the following configuration types:" for file in $config_files; do echo `echo $file | sed 's/\.conf//'` - `head -1 $file | sed 's/#//'` done fi exit 1 fi # By default the PGPLOT library is initially placed in the current # The demos should be explicitly linked against this library. PGPLOT_LIB="-L\`pwd\` -lpgplot" CPGPLOT_LIB="-L\`pwd\` -lcpgplot -lpgplot" # List the default make targets. DEFAULT_TARGETS="lib grfont.dat prog pgplot.doc" # Get the configuration variables. echo "Reading configuration file: $CONFIG" . $CONFIG # List the files that will need to be installed by the person who # is running this script. INSTALL_LIST="libpgplot.a $SHARED_LIB grfont.dat rgb.txt" #----------------------------------------------------------------------- # PGPLOT source directories. #----------------------------------------------------------------------- SRCDIR=$SRC/src OBSDIR=$SRC/obssrc DEMDIR=$SRC/examples FNTDIR=$SRC/fonts DRVDIR=$SRC/drivers PGDDIR=$SRC/pgdispd GENDIR=$SRC/sys #----------------------------------------------------------------------- # Device drivers #----------------------------------------------------------------------- ARDRIV="ardriv.o" BCDRIV="bcdriv.o" CADRIV="cadriv.o" CCDRIV="ccdriv.o" CGDRIV="cgdriv.o" CWDRIV="cwdriv.o" EPDRIV="epdriv.o" EXDRIV="exdriv.o" GCDRIV="gcdriv.o" GIDRIV="gidriv.o" GLDRIV="gldriv.o" GODRIV="godriv.o" GRDRIV="grdriv.o" GVDRIV="gvdriv.o" HGDRIV="hgdriv.o" HIDRIV="hidriv.o" HJDRIV="hjdriv.o" HPDRIV="hpdriv.o" IKDRIV="ikdriv.o" IMDRIV="imdriv.o" IRDRIV="irdriv.o" LADRIV="ladriv.o" LHDRIV="lhdriv.o" LIDRIV="lidriv.o" LJDRIV="ljdriv.o" LNDRIV="lndriv.o" LSDRIV="lsdriv.o" LVDRIV="lvdriv.o" LXDRIV="lxdriv.o" MFDRIV="mfdriv.o" NEDRIV="nedriv.o nexsup.o" NUDRIV="nudriv.o" PGDRIV="pgdriv.o" PKDRIV="pkdriv.o" PNDRIV="pndriv.o" PPDRIV="ppdriv.o" PSDRIV="psdriv.o" PXDRIV="pxdriv.o" PZDRIV="pzdriv.o" QMDRIV="qmdriv.o" SVDRIV="svdriv.o svblock.o" TFDRIV="tfdriv.o" TODRIV="todriv.o" TTDRIV="ttdriv.o" TXDRIV="txdriv.o" VADRIV="vadriv.o" VBDRIV="vbdriv.o" VEDRIV="vedriv.o" VIDRIV="vidriv.o" VTDRIV="vtdriv.o" WDDRIV="wddriv.o" WSDRIV="wsdriv.o" X2DRIV="x2driv.o figdisp_comm.o" XEDRIV="xedriv.o" XWDRIV="xwdriv.o" ZEDRIV="zedriv.o" XMDRIV="xmdriv.o pgxwin.o" XADRIV="xadriv.o pgxwin.o" TKDRIV="tkdriv.o pgxwin.o" RVDRIV="rvdriv.o pgxwin.o" # We need a drivers.list file in the current directory, from which to # determine the drivers to be compiled. if test -f drivers.list; then echo 'Selecting uncommented drivers from ./drivers.list' else cp $SRC/drivers.list . echo 'Please specify required drivers by un-commenting them in ./drivers.list.' echo "Then re-run $0" exit 1 fi # Get a list of driver names. DRIV_LIST=`awk '/^[^!]/{printf("$%s\n", $1)}' drivers.list | sort | uniq` echo "Found drivers `echo $DRIV_LIST | sed 's/\\\$//g'`" # Convert the list of drivers to the list of dependent object files. # This involves expanding the $xxDRIV driver-dependency variables, # and removing duplicate object files. DRIV_LIST=`eval echo $DRIV_LIST | awk '{for(i=1;i<=NF;i++) print $i}' | sort | uniq | awk '{printf("%s ", $0)} END{printf("\n")}'` # Add server targets to the default target list if their respective # drivers have been selected. if (echo $DRIV_LIST | grep -s x2driv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS pgdisp" INSTALL_LIST="$INSTALL_LIST pgdisp" fi if (echo $DRIV_LIST | grep -s xwdriv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS pgxwin_server" INSTALL_LIST="$INSTALL_LIST pgxwin_server" fi if (echo $DRIV_LIST | grep -s xmdriv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS libXmPgplot.a pgmdemo" INSTALL_LIST="$INSTALL_LIST libXmPgplot.a XmPgplot.h" fi if (echo $DRIV_LIST | grep -s xadriv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS libXaPgplot.a pgawdemo" INSTALL_LIST="$INSTALL_LIST libXaPgplot.a XaPgplot.h" fi if (echo $DRIV_LIST | grep -s tkdriv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS libtkpgplot.a pgtkdemo pgtkdemo.tcl" INSTALL_LIST="$INSTALL_LIST libtkpgplot.a tkpgplot.h" fi if (echo $DRIV_LIST | grep -s rvdriv 2>&1 1>/dev/null); then DEFAULT_TARGETS="$DEFAULT_TARGETS librvpgplot.a rvpgplot.h" INSTALL_LIST="$INSTALL_LIST librvpgplot.a rvpgplot.h" fi # PNDRIV requires extra libraries and include files if (echo $DRIV_LIST | grep -s pndriv 2>&1 1>/dev/null); then PGPLOT_LIB="$PGPLOT_LIB -lpng -lz" CPGPLOT_LIB="$CPGPLOT_LIB -lpng -lz" fi # Create a new grexec.f that calls the above drivers. awk -f $SRC/grexec.awk drivers.list > grexec.f # Some FORTRAN compilers expect their include files to appear in the # directory containing the source code. Others expect them to be in the # directory in which you actually do the compilation. To allow both cases # copy the include files into the current directory. cp $SRCDIR/*.inc . #----------------------------------------------------------------------- # Routine lists: # PG_ROUTINES: basic PGPLOT routines (Fortran-77). # PG_NON_STANDARD: non-Fortran-77 aliases for basic routines. # GR_ROUTINES: support routines, not called directly by applications # (Fortran-77). # SYSTEM_ROUTINES: potentially non-portable routines, usually # operating-system dependent. # OBSOLETE_ROUTINES: obsolete routines used by some programs. # DEMOS: demonstration programs #----------------------------------------------------------------------- PG_ROUTINES="\ pgarro.o\ pgask.o \ pgaxis.o\ pgaxlg.o\ pgband.o\ pgbbuf.o\ pgbeg.o \ pgbin.o \ pgbox.o \ pgbox1.o\ pgcirc.o\ pgcl.o \ pgclos.o\ pgcn01.o\ pgcnsc.o\ pgconb.o\ pgconf.o\ pgconl.o\ pgcons.o\ pgcont.o\ pgconx.o\ pgcp.o \ pgctab.o\ pgcurs.o\ pgdraw.o\ pgebuf.o\ pgend.o \ pgenv.o \ pgeras.o\ pgerr1.o\ pgerrb.o\ pgerrx.o\ pgerry.o\ pgetxt.o\ pgfunt.o\ pgfunx.o\ pgfuny.o\ pggray.o\ pghi2d.o\ pghis1.o\ pghist.o\ pghtch.o\ pgiden.o\ pgimag.o\ pginit.o\ pglab.o \ pglcur.o\ pgldev.o\ pglen.o \ pgline.o\ pgmove.o\ pgmtxt.o\ pgncur.o\ pgnoto.o\ pgnpl.o \ pgnumb.o\ pgolin.o\ pgopen.o\ pgpage.o\ pgpanl.o\ pgpap.o \ pgpixl.o\ pgpnts.o\ pgpoly.o\ pgpt.o \ pgpt1.o \ pgptxt.o\ pgqah.o \ pgqcf.o \ pgqch.o \ pgqci.o \ pgqcir.o\ pgqclp.o\ pgqcol.o\ pgqcr.o \ pgqcs.o \ pgqdt.o \ pgqfs.o \ pgqhs.o \ pgqid.o \ pgqinf.o\ pgqitf.o\ pgqls.o \ pgqlw.o \ pgqndt.o\ pgqpos.o\ pgqtbg.o\ pgqtxt.o\ pgqvp.o \ pgqvsz.o\ pgqwin.o\ pgrect.o\ pgrnd.o \ pgrnge.o\ pgsah.o \ pgsave.o\ pgscf.o \ pgsch.o \ pgsci.o \ pgscir.o\ pgsclp.o\ pgscr.o \ pgscrl.o\ pgscrn.o\ pgsfs.o \ pgshls.o\ pgshs.o \ pgsitf.o\ pgslct.o\ pgsls.o \ pgslw.o \ pgstbg.o\ pgsubp.o\ pgsvp.o \ pgswin.o\ pgtbox.o\ pgtext.o\ pgtick.o\ pgtikl.o\ pgupdt.o\ pgvect.o\ pgvsiz.o\ pgvstd.o\ pgvw.o \ pgwedg.o\ pgwnad.o\ " PG_NON_STANDARD="\ pgadvance.o\ pgbegin.o \ pgcurse.o \ pglabel.o \ pgmtext.o \ pgncurse.o \ pgpaper.o \ pgpoint.o \ pgptext.o \ pgvport.o \ pgvsize.o \ pgvstand.o \ pgwindow.o \ " GR_ROUTINES="\ grarea.o\ grbpic.o\ grchsz.o\ grclip.o\ grclos.o\ grclpl.o\ grctoi.o\ grcurs.o\ grdot0.o\ grdot1.o\ grdtyp.o\ gresc.o \ grepic.o\ gretxt.o\ grfa.o \ grfao.o \ grgfil.o\ grgray.o\ grimg0.o\ grimg1.o\ grimg2.o\ grimg3.o\ grinit.o\ gritoc.o\ grlen.o \ grlin0.o\ grlin1.o\ grlin2.o\ grlin3.o\ grlina.o\ grmcur.o\ grmker.o\ grmova.o\ grmsg.o\ gropen.o\ grpage.o\ grpars.o\ grpixl.o\ grpocl.o\ grprom.o\ grpxpo.o\ grpxps.o\ grpxpx.o\ grpxre.o\ grqcap.o\ grqci.o \ grqcol.o\ grqcr.o \ grqdev.o\ grqdt.o \ grqfnt.o\ grqls.o \ grqlw.o \ grqpos.o\ grqtxt.o\ grqtyp.o\ grquit.o\ grrec0.o\ grrect.o\ grsci.o \ grscr.o \ grscrl.o\ grsetc.o\ grsets.o\ grsfnt.o\ grsize.o\ grskpb.o\ grslct.o\ grsls.o \ grslw.o \ grsyds.o\ grsymk.o\ grsyxd.o\ grterm.o\ grtext.o\ grtoup.o\ grtrim.o\ grtrn0.o\ grtxy0.o\ grvct0.o\ grwarn.o\ grxhls.o\ grxrgb.o\ " SYSTEM_ROUTINES="\ grdate.o\ grfileio.o\ grflun.o\ grgcom.o\ grgenv.o\ grgetc.o\ grglun.o\ grgmem.o\ grgmsg.o\ grlgtr.o\ groptx.o\ grsy00.o\ grtermio.o\ grtrml.o\ grtter.o\ gruser.o\ " OBSOLETE_ROUTINES="\ grchar.o\ grchr0.o\ grdat2.o\ grgtc0.o\ grinqfont.o\ grinqli.o\ grinqpen.o\ grlinr.o\ grmark.o\ grmovr.o\ grsetfont.o\ grsetli.o\ grsetpen.o\ grtran.o\ grvect.o\ pgsetc.o\ pgsize.o\ " OPTIONAL_ROUTINES="\ iand.o\ " PGDISP_ROUTINES="\ cleanup.o\ pgdisp.o\ figcurs.o\ getdata.o\ getvisuals.o\ handlexevent.o\ proccom.o\ resdb.o\ exposelgwin.o\ getcolors.o\ initlgluts.o\ initlgwin.o\ initlock.o\ initwmattr.o\ mainloop.o\ resizelgwin.o\ returnbuf.o\ waitevent.o\ updatelgtitle.o\ " DEMOS="\ pgdemo1\ pgdemo2\ pgdemo3\ pgdemo4\ pgdemo5\ pgdemo6\ pgdemo7\ pgdemo8\ pgdemo9\ pgdemo10\ pgdemo11\ pgdemo12\ pgdemo13\ pgdemo14\ pgdemo15\ pgdemo16\ pgdemo17\ " # # If any optional system routines are found, add them to the # list of required system routines. # for file in `(echo $OPTIONAL_ROUTINES | sed 's/\.o//g')`; do if test -f $SYSDIR/${file}.c -o -f $SYSDIR/${file}.f; then SYSTEM_ROUTINES="$SYSTEM_ROUTINES ${file}.o" fi done # # System specific C wrapper routines for the standard drivers are # named ..wrap.c in the appropriate system directory, where .. is the # two letter ..driv.c prefix of a given driver. # for file in `(echo $DRIV_LIST | sed 's/\.o//g')`; do if test -f $DRVDIR/${file}.c; then wrapper="`(echo $file | sed 's/driv$/wrap/')`" if test -f $SYSDIR/${wrapper}.c -o -f $SYSDIR/${wrapper}.m ; then SYSTEM_ROUTINES="$SYSTEM_ROUTINES ${wrapper}.o" fi fi done # Don't override any existing (possibly modified version of rgb.txt). if test ! -f rgb.txt; then echo 'Copying color database.' cp $SRC/rgb.txt . fi echo "Creating make file: makefile" cat > makefile << EOD # Makefile for PGPLOT. # $0 $* # This file is automatically generated. Do not edit. # # This generates the PGPLOT binary files (libraries and demos) in the # current default directory (which need not be the source directory). #----------------------------------------------------------------------- SHELL=/bin/sh # PGPLOT subdirectories SRC=$SRC SRCDIR=$SRCDIR OBSDIR=$OBSDIR DEMDIR=$DEMDIR FNTDIR=$FNTDIR DRVDIR=$DRVDIR SYSDIR=$SYSDIR PGDDIR=$PGDDIR GENDIR=$GENDIR XMDIR=$DRVDIR/xmotif XADIR=$DRVDIR/xathena TKDIR=$DRVDIR/xtk # # Fortran compiler and compilation flags # FCOMPL=$FCOMPL FFLAGC=$FFLAGC FFLAGD=$FFLAGD # # C compiler and compilation flags # XINCL=$XINCL MOTIF_INCL=$MOTIF_INCL ATHENA_INCL=$ATHENA_INCL TK_INCL=$TK_INCL RV_INCL=$RV_INCL CCOMPL=$CCOMPL CFLAGC=$CFLAGC -I. CFLAGD=$CFLAGD MCOMPL=$MCOMPL MFLAGC=$MFLAGC # # Pgbind flags. # PGBIND_FLAGS=$PGBIND_FLAGS # # Loader library-flags # LIBS=$LIBS MOTIF_LIBS=$MOTIF_LIBS ATHENA_LIBS=$ATHENA_LIBS TK_LIBS=$TK_LIBS # # Loader command for PGPLOT library # PGPLOT_LIB=$PGPLOT_LIB CPGPLOT_LIB=$CPGPLOT_LIB # # Shared library creation. # SHARED_LIB=$SHARED_LIB SHARED_LD=$SHARED_LD # # The libraries that the shared PGPLOT library depends upon. # This is for systems that allow one to specify what libraries # undefined symbols of a shared library reside in. Such systems # (eg. Solaris 2.x) use this information at run time so that users of # the library don't have to list a slew of other implementation-specific # libraries when they link their executables. # SHARED_LIB_LIBS=$SHARED_LIB_LIBS # # Ranlib command if required # RANLIB=$RANLIB # # Routine lists. # PG_ROUTINES=$PG_ROUTINES PG_NON_STANDARD=$PG_NON_STANDARD GR_ROUTINES=$GR_ROUTINES SYSTEM_ROUTINES=$SYSTEM_ROUTINES OBSOLETE_ROUTINES=$OBSOLETE_ROUTINES DRIVERS=$DRIV_LIST PGDISP_ROUTINES=$PGDISP_ROUTINES DEMOS=$DEMOS # #----------------------------------------------------------------------- # Target "all" makes everything (except the library of obsolete routines) #----------------------------------------------------------------------- all: $DEFAULT_TARGETS @echo ' ';echo '*** Finished compilation of PGPLOT ***';echo ' ' @echo 'Note that if you plan to install PGPLOT in a different' @echo 'directory than the current one, the following files will be' @echo 'needed.' @echo ' ' EOD for file in $INSTALL_LIST; do echo " @echo ' $file'" done >> makefile cat >> makefile << EOD @echo ' ' @echo 'Also note that subsequent usage of PGPLOT programs requires that' @echo 'the full path of the chosen installation directory be named in' @echo 'an environment variable named PGPLOT_DIR.' @echo ' ' #----------------------------------------------------------------------- # Rules for compiling the .o files #----------------------------------------------------------------------- EOD echo 'Determining object file dependencies.' # List source code file dependencies explicitly. for file in `(echo $PG_ROUTINES | sed 's/\.o//g')`; do echo "${file}.o: \$(SRCDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(SRCDIR)/${file}.f" done >> makefile for file in `(echo $PG_NON_STANDARD | sed 's/\.o//g')`; do echo "${file}.o: \$(SRCDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(SRCDIR)/${file}.f" done >> makefile for file in `(echo $GR_ROUTINES | sed 's/\.o//g')`; do echo "${file}.o: \$(SRCDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(SRCDIR)/${file}.f" done >> makefile for file in `(echo $SYSTEM_ROUTINES | sed 's/\.o//g')`; do if test -f $SYSDIR/${file}.f; then echo "${file}.o: \$(SYSDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(SYSDIR)/${file}.f" elif test -f $SYSDIR/${file}.c; then echo "${file}.o: \$(SYSDIR)/${file}.c" echo " \$(CCOMPL) -c \$(CFLAGC) \$(SYSDIR)/${file}.c" elif test -f $SYSDIR/${file}.m; then echo "${file}.o: \$(SYSDIR)/${file}.m" echo " \$(MCOMPL) -c \$(MFLAGC) \$(SYSDIR)/${file}.m" elif test -f $GENDIR/${file}.f; then echo "${file}.o: \$(GENDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(GENDIR)/${file}.f" elif test -f $GENDIR/${file}.c; then echo "${file}.o: \$(GENDIR)/${file}.c" echo " \$(CCOMPL) -c \$(CFLAGC) \$(GENDIR)/${file}.c" else echo "Warning: Unable to find source code for ${file}.o in either $SYSDIR or $GENDIR" 1>&2 fi done >> makefile for file in `(echo $OBSOLETE_ROUTINES | sed 's/\.o//g')`; do echo "${file}.o: \$(OBSDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(OBSDIR)/${file}.f" done >> makefile # Emit pgdisp rules. for file in `(echo $PGDISP_ROUTINES | sed 's/\.o//g')`; do echo "${file}.o: \$(PGDDIR)/${file}.c" echo " \$(CCOMPL) -c \$(CFLAGC) \$(XINCL) -DPGDISP \$(PGDDIR)/${file}.c" done >> makefile # Emit driver dependencies. for file in `(echo $DRIV_LIST | sed 's/\.o//g')`; do if test -f $SYSDIR/${file}.f; then echo "${file}.o: \$(SYSDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(SYSDIR)/${file}.f" elif test -f $SYSDIR/${file}.c; then echo "${file}.o: \$(SYSDIR)/${file}.c" echo " \$(CCOMPL) -c \$(CFLAGC) \$(XINCL) \$(SYSDIR)/${file}.c" elif test -f $SYSDIR/${file}.m; then echo "${file}.o: \$(SYSDIR)/${file}.m" echo " \$(MCOMPL) -c \$(MFLAGC) \$(XINCL) \$(SYSDIR)/${file}.m" elif test -f $DRVDIR/${file}.f; then echo "${file}.o: \$(DRVDIR)/${file}.f" echo " \$(FCOMPL) -c \$(FFLAGC) \$(DRVDIR)/${file}.f" elif test -f $DRVDIR/${file}.c; then echo "${file}.o: \$(DRVDIR)/${file}.c" echo " \$(CCOMPL) -c \$(CFLAGC) \$(XINCL) \$(DRVDIR)/${file}.c" elif test -f $DRVDIR/${file}.m; then echo "${file}.o: \$(DRVDIR)/${file}.m" echo " \$(MCOMPL) -c \$(MFLAGC) \$(XINCL) \$(DRVDIR)/${file}.m" else echo "Unable to find source code for ${file}.o in $SYSDIR or $DRVDIR/" 1>&2 exit 1 fi done >> makefile cat >> makefile << \EOD #----------------------------------------------------------------------- # The device-driver dispatch routine is generated automatically by # reading the "drivers.list" file. #----------------------------------------------------------------------- DISPATCH_ROUTINE=grexec.o grexec.o: grexec.f $(FCOMPL) -c $(FFLAGC) grexec.f #----------------------------------------------------------------------- # Target "lib" is used to built the PGPLOT subroutine library. # libpgplot.a is the primary PGPLOT object library. # "shared" is an optional target for operating systems that allow shared # libraries. #----------------------------------------------------------------------- lib : libpgplot.a $(SHARED_LIB) libpgplot.a : $(PG_ROUTINES) $(PG_NON_STANDARD) $(GR_ROUTINES) \ $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES) ar ru libpgplot.a \ `ls $(PG_ROUTINES) \ $(PG_NON_STANDARD) $(GR_ROUTINES) $(DISPATCH_ROUTINE) \ $(DRIVERS) $(SYSTEM_ROUTINES) | sort | uniq` $(RANLIB) libpgplot.a EOD # Emit the shared library dependency if requested. if test -n "$SHARED_LIB" -a -n "$SHARED_LD"; then cat >> makefile << \EOD $(SHARED_LIB): $(PG_ROUTINES) $(PG_NON_STANDARD) \ $(GR_ROUTINES) $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES) $(SHARED_LD) `ls $(PG_ROUTINES) \ $(PG_NON_STANDARD) $(GR_ROUTINES) $(DISPATCH_ROUTINE) \ $(DRIVERS) $(SYSTEM_ROUTINES) | sort | uniq` $(SHARED_LIB_LIBS) EOD fi cat >> makefile << \EOD #----------------------------------------------------------------------- # libpgobs.a contains obsolete routines used by some programs #----------------------------------------------------------------------- libpgobs.a : $(OBSOLETE_ROUTINES) ar ru libpgobs.a $(OBSOLETE_ROUTINES) $(RANLIB) libpgobs.a #----------------------------------------------------------------------- # Target "prog" is used to make the demo programs. They can also be made # individually. #----------------------------------------------------------------------- prog: $(DEMOS) EOD # If the default pgplot library is shareable then the demos do not # need to be recompiled. If there is no shareable library then they # do, so add an extra dependency. if test ! \( -n "$SHARED_LIB" -a -n "$SHARED_LD" \); then EXTRA_DEPENDENCY="libpgplot.a" fi for file in $DEMOS; do echo "${file}: \$(DEMDIR)/${file}.f $EXTRA_DEPENDENCY" echo " \$(FCOMPL) \$(FFLAGD) -o ${file} \$(DEMDIR)/${file}.f \$(PGPLOT_LIB) \$(LIBS)" done >> makefile cat >> makefile << \EOD #----------------------------------------------------------------------- # Target "grfont.dat" is the binary font file. # This is created from grfont.txt with the "pgpack" program. # (a) compile the `pgpack' program; then # (b) run `pgpack' to convert the ASCII version of the font file # (grfont.txt) into the binary version (grfont.dat). When executed, # `pgpack' should report: # Characters defined: 996 # Array cells used: 26732 #----------------------------------------------------------------------- EOD ( if test -f $SYSDIR/pgpack.f; then echo "grfont.dat: \$(FNTDIR)/grfont.txt \$(SYSDIR)/pgpack.f" echo " \$(FCOMPL) \$(FFLAGC) -o pgpack \$(SYSDIR)/pgpack.f" elif test -f $SYSDIR/pgpack.c; then echo "grfont.dat: \$(FNTDIR)/grfont.txt \$(SYSDIR)/pgpack.c" echo " \$(CCOMPL) \$(CFLAGC) -o pgpack \$(SYSDIR)/pgpack.c" elif test -f $SYSDIR/pgpack.m; then echo "grfont.dat: \$(FNTDIR)/grfont.txt \$(SYSDIR)/pgpack.m" echo " \$(MCOMPL) \$(MFLAGC) -o pgpack \$(SYSDIR)/pgpack.m" else echo "grfont.dat: \$(FNTDIR)/grfont.txt \$(FNTDIR)/pgpack.f" echo " \$(FCOMPL) \$(FFLAGC) -o pgpack \$(FNTDIR)/pgpack.f" fi echo " rm -f grfont.dat" echo " ./pgpack <\$(FNTDIR)/grfont.txt" echo " rm -f pgpack" ) >> makefile cat >> makefile << \EOD #----------------------------------------------------------------------- # Documentation files #----------------------------------------------------------------------- EOD PG_SOURCE=`echo " $PG_ROUTINES $PG_NON_STANDARD" | sed -e 's|\.o|\.f|g' -e 's| pg| $(SRCDIR)/pg|g'` ( echo "PG_SOURCE=$PG_SOURCE" echo "pgplot.doc: \$(PG_SOURCE)" echo " $SRC/makedoc \$(PG_SOURCE) > pgplot.doc" echo "pgplot.html: \$(PG_SOURCE)" echo " $SRC/makehtml \$(PG_SOURCE) > pgplot.html" echo "pgplot.hlp: \$(PG_SOURCE)" echo " $SRC/makehelp \$(PG_SOURCE) > pgplot.hlp" echo "pgplot-routines.tex: \$(PG_SOURCE)" echo " $SRC/maketex \$(PG_SOURCE) > pgplot-routines.tex" ) >> makefile cat >> makefile << \EOD #----------------------------------------------------------------------- # Target "pgxwin_server" is the server program for the XW driver #----------------------------------------------------------------------- pgxwin_server: $(DRVDIR)/pgxwin_server.c $(CCOMPL) $(CFLAGC) $(XINCL) -o pgxwin_server $(DRVDIR)/pgxwin_server.c $(LIBS) #----------------------------------------------------------------------- # Target "pgdisp" is the pgdisp server program for /XDISP driver #----------------------------------------------------------------------- pgdisp: $(PGDISP_ROUTINES) $(CCOMPL) $(CFLAGC) -o pgdisp $(PGDISP_ROUTINES) $(LIBS) #----------------------------------------------------------------------- # Target "libxmpgplot.a" contains the Motif widget driver. #----------------------------------------------------------------------- libXmPgplot.a: XmPgplot.o ar ru libXmPgplot.a XmPgplot.o $(RANLIB) libXmPgplot.a XmPgplot.h: $(XMDIR)/XmPgplot.h cp $(XMDIR)/XmPgplot.h XmPgplot.h XmPgplot.o: $(DRVDIR)/pgxwin.h XmPgplot.h $(XMDIR)/XmPgplotP.h $(XMDIR)/XmPgplot.c $(CCOMPL) -c $(CFLAGC) -I$(DRVDIR) -I$(XMDIR) $(MOTIF_INCL) $(XMDIR)/XmPgplot.c #----------------------------------------------------------------------- # Target "libxapgplot.a" contains the Motif widget driver. #----------------------------------------------------------------------- libXaPgplot.a: XaPgplot.o ar ru libXaPgplot.a XaPgplot.o $(RANLIB) libXaPgplot.a XaPgplot.h: $(XADIR)/XaPgplot.h cp $(XADIR)/XaPgplot.h XaPgplot.h XaPgplot.o: $(DRVDIR)/pgxwin.h XaPgplot.h $(XADIR)/XaPgplotP.h $(XADIR)/XaPgplot.c $(CCOMPL) -c $(CFLAGC) -I$(DRVDIR) -I$(XADIR) $(MOTIF_INCL) $(XADIR)/XaPgplot.c #----------------------------------------------------------------------- # Target "libtkpgplot.a" contains the Tk widget driver. #----------------------------------------------------------------------- libtkpgplot.a: tkpgplot.o ar ru libtkpgplot.a tkpgplot.o $(RANLIB) libtkpgplot.a tkpgplot.h: $(TKDIR)/tkpgplot.h cp $(TKDIR)/tkpgplot.h tkpgplot.h tkpgplot.o: $(DRVDIR)/pgxwin.h tkpgplot.h $(TKDIR)/tkpgplot.c $(CCOMPL) -c $(CFLAGC) -I$(DRVDIR) -I$(TKDIR) $(TK_INCL) $(TKDIR)/tkpgplot.c #----------------------------------------------------------------------- # Target "librvpgplot.a" contains the Rivet-Tk widget driver. #----------------------------------------------------------------------- librvpgplot.a: rvpgplot.o ar ru librvpgplot.a rvpgplot.o $(RANLIB) librvpgplot.a rvpgplot.h: $(TKDIR)/rvpgplot.h cp $(TKDIR)/rvpgplot.h rvpgplot.h rvpgplot.o: $(DRVDIR)/pgxwin.h rvpgplot.h $(TKDIR)/tkpgplot.c $(CCOMPL) -o $@ -c -DUSE_RIVET $(CFLAGC) -I$(DRVDIR) -I$(TKDIR) $(RV_INCL) $(TKDIR)/tkpgplot.c #----------------------------------------------------------------------- # Target "install" is required for Figaro. #----------------------------------------------------------------------- install: #----------------------------------------------------------------------- # Target "clean" is used to remove all the intermediate files. #----------------------------------------------------------------------- clean : -@rm -f $(PG_ROUTINES) $(PG_NON_STANDARD) $(GR_ROUTINES)\ $(DISPATCH_ROUTINE) $(DRIVERS) $(SYSTEM_ROUTINES)\ $(OBSOLETE_ROUTINES) $(PGDISP_ROUTINES) pgmdemo.o\ XmPgplot.o pgbind tkpgplot.o pgtkdemo.o rvpgplot.o\ pgbind.o pgdemo*.o pgawdemo.o #----------------------------------------------------------------------- # Include file dependencies #----------------------------------------------------------------------- EOD ( cd $SRCDIR echo "# The following routines reference pgplot.inc" echo echo `grep -l pgplot.inc *.f | sed "s/\.f/\.o/g"` : "\$(SRCDIR)/pgplot.inc" echo echo "# The following routines reference grpckg1.inc" echo echo `grep -l grpckg1.inc *.f | sed "s/\.f/\.o/g"` : "\$(SRCDIR)/grpckg1.inc" echo ) >> makefile cat >> makefile << \EOD # Miscellaneous include files required by drivers griv00.o : $(DRVDIR)/gadef.h $(DRVDIR)/gmdef.h $(DRVDIR)/gphdef.h grivas.o : $(DRVDIR)/gadef.h grtv00.o : $(DRVDIR)/imdef.h pgxwin.o : $(DRVDIR)/pgxwin.h pndriv.o : ./png.h ./pngconf.h ./zlib.h ./zconf.h x2driv.o figdisp_comm.o: $(DRVDIR)/commands.h cpg: libcpgplot.a cpgplot.h cpgdemo @echo ' ' @echo '*** Finished compilation of the C PGPLOT wrapper library ***' @echo ' ' @echo 'Note that if you plan to install the library in a different' @echo 'directory than the current one, both libcpgplot.a and cpgplot.h' @echo 'will be needed.' @echo ' ' pgbind: $(SRC)/cpg/pgbind.c $(CCOMPL) $(CFLAGC) $(SRC)/cpg/pgbind.c -o pgbind libcpgplot.a cpgplot.h: $(PG_SOURCE) pgbind ./pgbind $(PGBIND_FLAGS) -h -w $(PG_SOURCE) $(CCOMPL) -c $(CFLAGC) cpg*.c rm -f cpg*.c ar ru libcpgplot.a cpg*.o $(RANLIB) libcpgplot.a rm -f cpg*.o cpgdemo: cpgplot.h $(SRC)/cpg/cpgdemo.c libcpgplot.a $(CCOMPL) $(CFLAGD) -c -I. $(SRC)/cpg/cpgdemo.c $(FCOMPL) -o cpgdemo cpgdemo.o $(CPGPLOT_LIB) $(LIBS) rm -f cpgdemo.o pgmdemo: pgmdemo.o libXmPgplot.a $(FCOMPL) -o pgmdemo pgmdemo.o -L`pwd` -lXmPgplot $(CPGPLOT_LIB) $(MOTIF_LIBS) pgmdemo.o: $(XMDIR)/pgmdemo.c XmPgplot.h libcpgplot.a cpgplot.h $(CCOMPL) $(CFLAGD) -c -I`pwd` $(MOTIF_INCL) $(XMDIR)/pgmdemo.c pgawdemo: pgawdemo.o libXaPgplot.a $(FCOMPL) -o pgawdemo pgawdemo.o -L`pwd` -lXaPgplot $(CPGPLOT_LIB) $(ATHENA_LIBS) pgawdemo.o: $(XADIR)/pgawdemo.c XaPgplot.h libcpgplot.a cpgplot.h $(CCOMPL) $(CFLAGD) -c -I`pwd` $(ATHENA_INCL) $(XADIR)/pgawdemo.c pgtkdemo: pgtkdemo.o libtkpgplot.a $(FCOMPL) -o pgtkdemo pgtkdemo.o -L`pwd` -ltkpgplot $(CPGPLOT_LIB) $(TK_LIBS) pgtkdemo.tcl: $(TKDIR)/pgtkdemo.tcl cp $(TKDIR)/pgtkdemo.tcl pgtkdemo.tcl chmod a+x pgtkdemo.tcl pgtkdemo.o: $(TKDIR)/pgtkdemo.c tkpgplot.h libcpgplot.a cpgplot.h $(CCOMPL) $(CFLAGD) -c -I`pwd` $(TK_INCL) $(TKDIR)/pgtkdemo.c EOD ------------------------------- # The device-driver dispatch routine is generated automatically by # reading the "drivers.list" file. #----------------------------------------------------------------------- DISPATCH_ROUTINE=grexec.o grexec.o: grexec.f $(FCOMPL) -c $(FFLAGC) grexec.f #----------------------------------------------------------------------- # Target "lib" is usedpgplot/update_config_files010075500040640000322000000227740631660750000164700ustar00tjpcitmbr00000400000017#!/bin/sh #----------------------------------------------------------------------- # The following function renders a commented configuration-variable # definition to the standard output. # # Inputs: # $1 The name of the variable. # $2 The default value to give the variable if not defined in the # original configuration file. # $3 The multi-line comment that should precede the variable # definition. #----------------------------------------------------------------------- output_variable() { # Write the comment. echo "$3" echo ' ' # If a definition for the variable exists in the original file, # use that definition in the output file. Otherwise adopt the default # specified in $2. if egrep -s -e "^ *$1" $input; then egrep -e "^ *$1" $input else echo " $1=\"$2\"" fi } # Rewrite each of the existing system configuration files, one at a # time. for input in `find sys_* -name '*.conf' -print`; do # Compose a new output file name so that the input file # doesn't get clobbered until we have had a chance to check for # unresolved differences. output="${input}_new" echo '' echo --------------- echo Creating $output # Discard any old reconfiguration. rm -f $output # Write the new configuration file. Note that the open-parenthesis on the # next line is matched by a close-parenthesis near the end of this script. # This is used so that standard output of all the enclosed commands can # be redirected in one go to the output file. Without the parenthesis # we would have to append the output of each command individually. That # would be much slower. ( #----------------------------------------------------------------------- # Preserve any system-specific comments that are found at the start of # the original configuration file. #----------------------------------------------------------------------- awk '{if($0 ~ /^[ \t]*#/ || $0 ~ /^[ \t]*$/) {print $0} else {exit}}' $input # Write the configuration variable descriptions and assignments. #----------------------------------------------------------------------- # XINCL #----------------------------------------------------------------------- output_variable XINCL "" ' # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files.' #----------------------------------------------------------------------- # MOTIF_INCL #----------------------------------------------------------------------- output_variable MOTIF_INCL "$XINCL" ' # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files.' #----------------------------------------------------------------------- # TKDRIV #----------------------------------------------------------------------- output_variable TK_INCL "-I/usr/local/include $XINCL" ' # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files.' #----------------------------------------------------------------------- # RV_INCL #----------------------------------------------------------------------- output_variable RV_INCL "" ' # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files.' #----------------------------------------------------------------------- # FCOMPL #----------------------------------------------------------------------- output_variable FCOMPL "" ' # Mandatory. # The FORTRAN compiler to use.' #----------------------------------------------------------------------- # FFLAGC #----------------------------------------------------------------------- output_variable FFLAGC "" ' # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed)' #----------------------------------------------------------------------- # FFLAGD #----------------------------------------------------------------------- output_variable FFLAGD "" ' # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences' #----------------------------------------------------------------------- # CCOMPL #----------------------------------------------------------------------- output_variable CCOMPL "" ' # Mandatory. # The C compiler to use.' #----------------------------------------------------------------------- # CFLAGC #----------------------------------------------------------------------- output_variable CFLAGC "" ' # Mandatory. # The C compiler flags to use when compiling the pgplot library.' #----------------------------------------------------------------------- # CFLAGD #----------------------------------------------------------------------- output_variable CFLAGD "" ' # Mandatory. # The C compiler flags to use when compiling C demo programs.' #----------------------------------------------------------------------- # PGBIND_FLAGS #----------------------------------------------------------------------- output_variable PGBIND_FLAGS "" ' # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage)' #----------------------------------------------------------------------- # LIBS #----------------------------------------------------------------------- output_variable LIBS "" ' # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs.' #----------------------------------------------------------------------- # XMDRIV #----------------------------------------------------------------------- output_variable MOTIF_LIBS "-lXm -lXt $LIBS" ' # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs.' #----------------------------------------------------------------------- # TKDRIV #----------------------------------------------------------------------- output_variable TK_LIBS "-L/usr/local/lib -ltk -ltcl $LIBS -ldl" ' # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl.' #----------------------------------------------------------------------- # RANLIB #----------------------------------------------------------------------- output_variable RANLIB ":" ' # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command).' #----------------------------------------------------------------------- # SHARED_LIB #----------------------------------------------------------------------- output_variable SHARED_LIB "" ' # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library.' #----------------------------------------------------------------------- # SHARED_LD #----------------------------------------------------------------------- output_variable SHARED_LD "" ' # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files.' #----------------------------------------------------------------------- # SHARED_LIB_LIBS #----------------------------------------------------------------------- output_variable SHARED_LIB_LIBS "" ' # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD' #----------------------------------------------------------------------- # MCOMPL #----------------------------------------------------------------------- output_variable MCOMPL "" ' # Optional: # Compiler name used on Next systems to compile objective-C files.' #----------------------------------------------------------------------- # MFLAGC #----------------------------------------------------------------------- output_variable MFLAGC "" ' # Optional: # Compiler flags used with MCOMPL when compiling objective-C files.' #----------------------------------------------------------------------- # SYSDIR #----------------------------------------------------------------------- output_variable SYSDIR '$SYSDIR' ' # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name".' #----------------------------------------------------------------------- # Redirect the output of the above commands to the new configuration file. ) > $output # Check for unexpected differences between the old and new # configuration files. if [ `diff $input $output | egrep '^<' | wc -l` -gt 0 ]; then echo "*** The following lines of $input were not found at the" echo "*** equivalent locations in $output" diff $input $output | egrep '^<' fi echo --------------- done ----pgplot/makehelp010075500040640000322000000025370630463637600142720ustar00tjpcitmbr00000400000017#!/bin/sh # Extract documentation from pgplot source code: output VMS help file cat << \EOD 1 PGPLOT PGPLOT GRAPHICS SUBROUTINE LIBRARY Version 5.2 PGPLOT is a Fortran subroutine package for drawing graphs on a variety of display devices. For more details, see the manual ``PGPLOT Graphics Subroutine Library'' available from T. J. Pearson (tjp@astro.caltech.edu). Arguments The subroutine descriptions indicate the data type of each argument. When arguments are described as ``input'', they may be replaced with constants or expressions in the CALL statement, but make sure that the constant or expression has the correct data type. INTEGER arguments: these should be declared INTEGER or INTEGER*4 in the calling program, not INTEGER*2. REAL arguments: these should be declared REAL or REAL*4 in the calling program, not REAL*8 or DOUBLE PRECISION. LOGICAL arguments: these should be declared LOGICAL or LOGICAL*4 in the calling program. CHARACTER arguments: any valid Fortran CHARACTER variable may be used (declared CHARACTER*n for some integer n). EOD awk ' /^C\*/ { print ""; print "2 " substr($0, 3, 500); } /^C\+/ { echo = 1; getline } /^C--/ { echo = 0} echo == 1 && /^C/ {print " " substr($0, 3, 500) } echo == 1 && !/^C/ { print } ' $* pgplot/makehtml010075500040640000322000000073450630513040100142630ustar00tjpcitmbr00000400000017#!/usr/local/bin/perl $, = ' '; # set output field separator $\ = "\n"; # set output record separator @files = @ARGV; print <<'EOD'; PGPLOT Subroutine Descriptions

PGPLOT Subroutine Descriptions

Introduction

This appendix includes a list of all the PGPLOT subroutines, and then gives detailed instructions for the use of each routine in Fortran programs. The subroutine descriptions are in alphabetical order.

Arguments

The subroutine descriptions indicate the data type of each argument. When arguments are described as ``input'', they may be replaced with constants or expressions in the CALL statement, but make sure that the constant or expression has the correct data type.
INTEGER arguments:
these should be declared INTEGER or INTEGER*4 in the calling program, not INTEGER*2.
REAL arguments:
these should be declared REAL or REAL*4 in the calling program, not REAL*8 or DOUBLE PRECISION.
LOGICAL arguments:
these should be declared LOGICAL or LOGICAL*4 in the calling program.
CHARACTER arguments:
any valid Fortran CHARACTER variable may be used (declared CHARACTER*n for some integer n).

Index of Routines

Version 5.2

EOD # Extract documentation from pgplot source code: output index of routines print '

    '; while (<>) { chop; # strip record separator if (/^C\*/) { ($module, $rest) = split (' ', $_, 2); $module = substr($module, 2); print "
  • $module $rest"; $ref{$module} = "$module"; push (@modules, $module); } } # reverse sort so that modules with the same first few characters occur # longest to shortest. @modules = sort {length($b) <=> length($a)} @modules; print '
'; # Extract documentation from pgplot source code: output HTML code @ARGV = @files; while (<>) { s/\&/\&\;/g; s/\>/\>\;/g; s/\'; ($module, $rest) = split (' ', substr($_, 2), 2); print "

$module $rest

"; next; }; /^C\+/ && do { print '
' if $echo == 0;
    $echo = 1;
    print &Getline0();
    next;
  };

  /^C--/ && do
  {
    print '
' if $echo == 1; $echo = 0; next; }; next if ! $echo; /^C/ && do { # replace module names with links. when a module name is recognized, # it's replaced by a tag in the line to avoid multiple recognitions # (by modules which have similar substrings). the tags are replaced # by the actual links after all identifications have been made. # it'd be cheaper to have the tags be variables that could be # interpolated, but there's no guarantee that the rest of the text # wouldn't be adversely affected. thus, a set of replacements is # created and then eval'd $line = substr($_, 2); $reps = 0; $repstr = ''; foreach $module (@modules) { $start = index($line, $module); next if $start == -1; $tag = sprintf("REPLACE<%04d>", $reps); $line = join('', substr($line, 0, $start), $tag, substr($line, $start+length($module))); $repstr .= "\$line =~ s:$tag:$ref{$module}:;\n"; ++$reps; } eval $repstr if $repstr ne ''; print $line; next; }; print; } print <<'EOD';
EOD sub Getline0 { if ($getline_ok = (($_ = <>) ne '')) { chop; # strip record separator } $_; } stant or expression has the correct data type.
INTEGER arguments:
these should be declared INTEGER or INTEGER*4 in the calling program, not INTEGER*2.
REAL arguments:
these should be declared 0) { ndev++; driver[ndev] = substr($1,1,drivpos-1); mode[ndev] = $2; } } END { printf(" PARAMETER (NDEV=%d)\n", ndev); printf(" CHARACTER*10 MSG\n"); printf("C---\n"); printf(" GOTO("); for(i=1; i<=ndev; i++) { if(i%15 == 0) printf("\n + "); printf("%d", i); if(i success; any other value => error. C----------------------------------------------------------------------- INTEGER IER IF (MODE.EQ.1) THEN OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER) ELSE OPEN (UNIT=UNIT, FILE=NAME, STATUS='OLD', IOSTAT=IER) END IF GROPTX = IER C----------------------------------------------------------------------- END pgplot/sys_salford/grtrml.f010064400040640000322000000011540573563134100165500ustar00tjpcitmbr00000400000017C*GRTRML -- get name of user's terminal (MS-DOS) C+ SUBROUTINE GRTRML(CTERM, LTERM) CHARACTER CTERM*(*) INTEGER LTERM C C Return the device name of the user's terminal, if any. C C Arguments: C CTERM : receives the terminal name, truncated or extended with C blanks as necessary. C LTERM : receives the number of characters in CTERM, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 1989-Nov-08 C----------------------------------------------------------------------- CTERM = 'CON' LTERM = 3 RETURN END pgplot/sys_salford/grtter.f010064400040640000322000000014030573563141000165420ustar00tjpcitmbr00000400000017C*GRTTER -- test whether device is user's terminal (MS-DOS) C+ SUBROUTINE GRTTER(CDEV, QSAME) CHARACTER CDEV*(*) LOGICAL QSAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C CDEV : (input) the device name to be tested. C QSAME : (output) .TRUE. is CDEV contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CTERM*64 INTEGER LTERM C CALL GRTRML(CTERM, LTERM) QSAME = (CDEV.EQ.CTERM(:LTERM)) END pgplot/sys_salford/gruser.f010064400040640000322000000010370573563143600165550ustar00tjpcitmbr00000400000017C*GRUSER -- get user name (MS-DOS) C+ SUBROUTINE GRUSER(CUSER, LUSER) CHARACTER CUSER*(*) INTEGER LUSER C C Return the name of the user running the program. C C Arguments: C CUSER : receives user name, truncated or extended with C blanks as necessary. C LUSER : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 1989-Mar-19 - [AFT] C----------------------------------------------------------------------- C CALL GRGENV('USER', CUSER, LUSER) RETURN END pgplot/sys_salford/grsy00.f010064400040640000322000000063170573563150600163760ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C----------------------------------------------------------------------- CHARACTER*(*) DEFNAM PARAMETER (DEFNAM='grfont.dat') INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END pgplot/pscaps.sh010075500040640000322000000022300575351752000143700ustar00tjpcitmbr00000400000017#!/bin/csh # # Move BoundingBox statement in PostScript files from epilogue to # prologue. This is useful for use with some applications which don't # fully implement the Adobe DSC for Encapsulated PostScript (eg. they # don't support a deferred bounding box specification using # %%BoundingBox: (atend) # # Version 1.0: RGW 12-Apr-1994 # Version 1.1: RGW 29-Jan-1995 # # Usage: pscaps # # set version="1.1" set tmpfile=pscaps.tempfile unalias mv echo "PSCaps Version $version (rgw 29-Jan-1995)" foreach file ($*) if ( -e $file ) then echo "Processing file $file..." set truebox=`fgrep '%%BoundingBox:' $file|fgrep -v atend` set atline=`fgrep -n '%%BoundingBox: (atend)' $file|awk -F':' '{print $1}'` if ($atline == "" ) then echo "File '$file' does not contain %%BoundingBox: (atend) construct" echo "Not a PGPLOT file, or already pscaps'ed" else @ prologue = $atline - 1 @ restoffile = $atline + 1 head -$prologue $file >! $tmpfile echo $truebox >> $tmpfile tail +${restoffile}l $file >> $tmpfile mv $tmpfile $file endif else echo "File '$file' does not exist" endif end exit pgplot/ver501.txt010064400040640000322000000121540576615364400143400ustar00tjpcitmbr00000400000017PGPLOT changes in Version 5.0.1 This version corrects several minor bugs; corrects a serious error in PGGRAY; adds functionality to the X window driver; adds a new driver for X window dump files. pgplot aaaread.me Split into files aaaread.me, install.txt, whatsnew.txt, changes.txt. drivers.list Add warning that use of GIDRIV may require a license. Add /WD and /VWD (X-window dump files). Add comments to discourage people from trying to use PC drivers on UNIX systems. Revise /VERS and /VVERS. makehtml New perl script now generates syntactically correct html with cross-references [Diab Jerius]. makemake Add instructions for SVdriv and WDdriv. Make it work with bash as well as sh. No longer makes pgplot.html by default. Remove VVdriv. pgplot/drivers gidriv.f Avoid integer overflow (caused driver to crash on VAX/VMS). Add warning that use of this driver may require a license from Unisys. tfdriv.f Correct error in usage of GRFMEM. svdriv.c, svblock.c Restored from v4.9H (note: this driver for SunView is no longer supported: use XWdriv instead). vedriv.f Merge landscape and portrait modes in one driver. vvdriv.f Deleted. wddriv.f New file: generates X-window dump file [Scott Allendorf]. xwdriv.c, pgxwin_server.c Fixes to datatypes of properties: corrects bugs found on Cray and Dec-Alpha (OSF/1). Support for all visual types, including TrueColor. Ability to set different attributes for each window via X resources. On VMS, checks that pgxwin_server has E or R access. x2driv.c, figdisp_comm.c Suppress warning messages produced by DECC compiler. bcdriv.f, ccdriv.f, hjdriv.f, ladriv.f, ljdriv.f, todriv.f, txdriv.f Eliminate use of routine gribf1. pgplot/examples pgdemo2.f Add a test of an invisible polygon. pgplot/fonts aaaread.me Note that pgunpack and pgdchar are unsupported. pgplot/src grcurs.f Correct bug: start new picture if necessary. grldev.f Change ``Legal PGPLOT device types are:'' to ``Device types available:''. grmker.f Fix bug: viewport grew as symbols were plotted! pgband.f, pgcurs.f Issue message if device is not open. pggray.f, grgray.f PGGRAY now uses a color ramp between the colors assigned to color index 0 (background) and color index 1 (foreground). This should restore the old behavior: the ramp runs from black to white on devices with black background and white foreground, and from white to black on devices with white background and black foreground. pgpage.f If this routine detects that the size of the view surface has been changed (e.g., by a workstation window manager), it now rescales the viewport in proportion. Formerly the size of the viewport (in absolute units, e.g., mm) was not changed and so the viewport might extend outside the view surface. This only affects programs that do not reset the viewport for each page. pgpoly.f, grpocl.f Correct bug: an invisible polygon generated a spurious error message. pgqcs.f, pglen.f, pgqvsz.f Fix minor formatting errors in header comments. pgqinf.f Change version to 5.0.1. pgslw.f, pgqlw.f, grslw.f Correct header comments (line width unit is 0.005 inch). pgplot/sys gribf1.f Deleted (also system-dependent variants). grfileio.c Add O_TRUNC to cause truncation when an existing file is overwritten. pgplot/sys_convex fc_cc.conf Added -lX11. pgplot/sys_cray aaaread.me Removed note about /XWIN: it now works. grfileio.c add O_TRUNC to cause truncation when an existing file is overwritten. pgplot/sys_linux aaaread.me New file: note that many drivers cannot be compiled; note about disabling backslash interpretation. f77_gcc.conf Corrected to use ranlib, and revised list of libraries. pgplot/sys_next pgview/PGView.m [Allyn Tennant] Correct resize bar. af77_src/grfileio.c add O_TRUNC to cause truncation when an existing file is overwritten. pgplot/sys_sol2 aaaread.me Added warning about non-ANSI C compilers. pgplot/sys_sun aaaread.me Added note about SunView driver. pgplot/sys_vms build.com Add PGQITF, PGSITF, PGPANL to transfer vector. grfileio.c Suppress warning messages produced by DECC compiler. Add O_TRUNC to cause a new version of the file to be created instead of overwriting (usual VMS behavior). grlgtr.f Convert supplied string to uppercase before attempting to translate it as a logical name. make_demos.com Correct comment. make_font.com Change protection of grfont.dat. ------------------------------------------------------------------------------- pgplot/ver500.txt010064400040640000322000000113070576615366000143340ustar00tjpcitmbr00000400000017PGPLOT Version 5.0 All changes are intended to be backwards-compatible: i.e., existing programs should run correctly when recompiled, and recompilation should not be necessary. Some programs may give slightly different results, owing to the bug fixes described below. New installation procedure The installation procedure for UNIX systems has changed substantially, to allow automatic generation of the makefile and the device dispatch routine (grexec.f). New C binding This release of PGPLOT includes an experimental C binding for calling PGPLOT from C programs. It consists of two files, a header file cpgplot.h that should be included in C programs that call PGPLOT, and a system-dependent wrapper library that encapsulates the manipulations necessary to call Fortran subroutines from C programs (e.g, converting C null-terminated char arrays to Fortran character strings). The wrapper library requires an ANSI-compliant C compiler, and is not available on all systems (interlanguage calls are very difficult or impossible on some systems). Changes to device drivers * PostScript: the PostScript device driver (device types /PS, /VPS, /CPS, and /VCPS) has been changed to handle the new PGIMAG routine. Use /CPS or /VCPS for color images. One side-effect is that the monochrome types (/PS and /VPS) now honor color representation changes requested by PGSCR, although they substitute a grey level for the requested color. * X-Window: the X-Window driver has had major changes to speed it up, make it more portable, and add new features. The window is now resizable, and it is possible to specify that it stay up after the PGPLOT program exits. The driver provides support for the new cursor features in PGBAND. The number of colors reserved and the default placement of the window can be specified in X resources. * GIF (Graphics Interchange Format): a new driver to create GIF files (type /GIF or /VGIF). * PPM (Portable Pixmap): a new driver to create PPM files (type /PPM or /VPPM). * Many of the other drivers have been cleaned up to make them more portable. New routines For details of all the PGPLOT routines, see file pgplot.doc or pgplot.html that the installation procedures puts in the pgplot directory. The file pgplot.html can be viewed with Mosaic (e.g., Mosaic /usr/local/pgplot/pgplot.html). * PGSCIR, PGQCIR: set/query the range of color indices used by routines PGGRAY and PGIMAG. * PGERAS: erase screen without advancing to new page. * PGCONL: for labelling contours drawn with PGCONT. * PGBAND: new cursor routine, with many more features than PGCURS including cross-hairs and rubber-bands (on devices that support this; currently only X-window). * PGIMAG: new routine (like PGGRAY) for color images. * PGCTAB: for generating a color table for use with PGIMAG. * PGSITF/PGQITF: set/query the image transfer function used by routines PGGRAY and PGIMAG. * PGPANL: to move to a different panel when the view surface has been divided into panels with PGBEG or PGSUBP. The pgdem* programs in pgplot/examples have been enhanced to demonstrate the new routines, and there are new demos programs (10--12). Enhanced routines * PGBOX: new options for forcing decimal or exponential labeling. * PGBEG (PGBEGIN): now parses device specifications differently, so that file names including slash characters do not need to be quoted. * PGCONX: contours are now traced in a consistent direction (clockwise or anticlockwise). * PGGRAY: enhanced to allow use of linear, log, or square-root mapping of array value onto image brightness (see PGSITF). * PGPIXL: new algorithm makes smaller PS files that print faster. * PGPAGE: no longer beeps when prompting for next page. Bugs fixed * PGNUMB: the FORM argument was ignored, but is now used as documented. * PGPAP (PGPAPER) was boken in 4.9H; it now works as documented, and can be used to change size between pages. * PGQCR: now works as advertised (on most devices). * Calling PGSCR before starting a new page (or defining PGPLOT_BACKGROUND or PGPLOT_FOREGROUND) no longer creates a blank page in the graphics file. * Filled polygons are now correctly clipped against the window on all devices; formerly they were not clipped on PostScript and X-Window devices. * The unit of line-width in PGSLW is now 0.005 inch on all devices. * Sometimes markers centered exactly on the edge of the window were not drawn when they should have been. ------------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1995 California Institute of Technology pgplot/ver510.txt010064400040640000322000000253440623050056600143270ustar00tjpcitmbr00000400000017PGPLOT version 5.1.0 Tested Systems Version 5.1.0 has been tested with the following operating systems and compilers. Drivers tested include: GI, GL, NU, PP, PS, TT, VT, WD, X2, XM, XW (but not all combinations of drivers and systems have been tested exhaustively). * SunOS 4.1.3_U1, Sun Fortran (f77) 1.3.1, GNU C (gcc) 2.7.0 (tested on SPARC 5). * Solaris 2.5 (SunOS 5.5), Sun Fortran (f77) 3.0.1, Sun C (cc) 3.0.1 (tested on SPARC IPX). * Solaris 2.5 (SunOS 5.5), Sun Fortran (f77) 3.0.1, GNU C (gcc) 2.7.2 (tested on SPARC IPX, SPARC Ultra-1). * OpenVMS AXP V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.1 (tested on DEC 3000/M600). * OpenVMS VAX V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.2 (tested on VAXstation 4000-90). Changes in Version 5.1.0 New Features 1. A major change in this version allows a program to have more than one PGPLOT device open at once. The devices can be of the same type, e.g., two windows on an X-window workstation, or of different types, e.g., a Tektronix terminal emulator and a PostScript file. Up to 8 devices may be open at once. To support this new feature, four new routines have been added: PGOPEN, PGQID, PGSLCT, and PGCLOS, and many routines have been modified internally. At present, support for multiple devices of the same type is not complete. Each PGPLOT device driver needs to be modified to support multiple devices of the same type (i.e., served by the same driver), or to explicitly prohibit opening more than one device. Some of the older drivers have not yet been modified, and these drivers may give incorrect results if you attempt to use them to open two devices. There should never be any problem with unlike devices served by different drivers, e.g., /XTERM and /PS. 2. A new driver (xmdriv) and support routines have been provided by Martin Shepherd to facilitate use of PGPLOT in a Motif application. Note that this is an experimental driver: feedback would be appreciated. 3. The C function prototypes (cpgplot.h) and C binding are now compatible with C++ as well as C. Bugs Fixed A bug has been fixed in GRPOCL (support routine for PGPOLY). This could cause overflow and incorrect plots if the world-coordinate values were greater than about 1E18 (on most machines). A rounding-error has been fixed in GRFA (support routine for PGPOLY); this could cause gaps between polygons that should abut. A bug has been fixed in GRPIXL (support routine for PGPIXL); this should improve speed. Two bugs have been fixed in the X-window driver (XWDRIV): it would sometimes cause color maps to be set incorrectly; it allowed only 255 colors, not 256. Drivers Removed The following device drivers have been moved into directory pgplot/drivers/old, and cannot be selected in a normal installation. I believe that no-one is still using these drivers: ardriv.f (Args image display), grdriv.f (Grinnell image display), ikdriv (Ikon pixel engine), lidriv (Liacom display), pkdriv.f and pzdriv.f (Peritek image displays), vedriv.f (Versatec V80 printer). ---------------------------------------------------------------------------- List of Changes pgplot aaaread.me, copyright notice, makedoc, makehtml Updated date and version number. drivers.list Added XMDRIV (Motif driver). Do not select this unless you have the necessary Motif support and plan to write Motif applications that call PGPLOT. Removed obsolete drivers as noted above. makemake Added new subroutines. Added targets pgplot.hlp (VMS help file); pgplot-routines.tex (LaTeX); pgmdemo (example Motif application). Name changes: pgdisp is now pgdispd (directory); pgview is now pgview.app (NeXT). makehelp (New file.) Script to generate VMS help file. maketex (New file.) Script to generate LaTeX documentation. pgdispd Changed name of directory from pgdisp to pgdispd to avoid problems if you try to compile PGPLOT in the source directory. ver510.txt (New file.) List of changes since previous version. pgplot/cpg cpgdemo.c Added a third page to exercise more routines. cpgplot.h Deleted file (note that this file needs to be created as part of the installation). pgbind.c Added C++ wrapper to the generated cpgplot.h file. Added support for const qualified declarations in the function prototypes. pgplot/drivers gidriv.f, ppdriv.f, psdriv.f, ttdriv, wddriv.f, x2driv.c Modified to prevent concurrent access. gidriv.f, ppdriv.f, psdriv.f, wddriv.f On some systems the decoding of environment variables PGPLOT_xx_WIDTH, HEIGHT failed owing to a bad Fortran format. Rewritten to avoid this problem. nudriv.f Modified to allow concurrent access (up to 8 devices). xmdriv.c, pgxwin.c, pgxwin.h New files: PGPLOT driver for Motif applications (from Martin Shepherd). xwdriv.c Fix bug in handling query-color-representation. pgxwin_server.c Fix bug: 256 colors allowed, not 255. pgplot/drivers/old New directory: several obsolete drivers (and associated drivers.list) have been moved from pgplot/drivers into this directory. These drivers should not be used; contact Tim Pearson if you still have a need for any of them. pgplot/drivers/xmotif New directory: support routines and example program for Motif applications. pgplot/examples Some of the example programs have been modified to use PGOPEN/PGCLOS instead of PGBEG/PGEND. pgdemo1.f Changed the pseudo-random number generator to avoid integer overflows. pgdemo6.f `+' key now cycles between cursor modes (rubber-band, cross-hair, etc.) pgdemo13.f (New program) Demonstration of two open devices. pgdemo14.f (New program) This program demonstrates a method of coding a user interface in PGPLOT. It requires the /XSERV device. For a more professional approach to graphical user interfaces, consider using the PGPLOT Motif driver. pgplot/src (Many pg routines) Changed the C function prototypes to use the const qualifier where appropriate. This makes it easier to use the function prototypes with C++. Most arguments declared float * or char * are now const float * or const char * (except for returned values). grpckg1.inc Modified to allow up to 8 concurrent devices. grfa.f Rounding-error fix (thanks to Remko Scharroo; twice). grinit.f New routine: initializes common block (avoids BLOCK DATA). grpixl.f Minor bug fix (Remko Scharroo). grpocl.f Rewrite to avoid potential overflow (thanks to Tomasz Plewa). pgplot.inc Modified to allow up to 8 concurrent devices; many variables changed from scalars to arrays, with new names. pgask.f, pgband.f, pgbbuf.f, pgbeg.f, pgbox.f, pgcirc.f, pgebuf.f, pgend.f, pgerrb.f, pgerrx.f, pgerry.f, pggray.f, pghi2d.f, pgiden.f, pgimag.f, pglen.f, pgmtxt.f, pgncur.f, pgnoto.f, pgpage.f, pgpanl.f, pgpap.f, pgpoly.f, pgptxt.f, pgqah.f, pgqch.f, pgqcir.f, pgqcs.f, pgqfs.f, pgqhs.f, pgqinf.f, pgqitf.f, pgqtbg.f, pgqtxt.f, pgqvp.f, pgqvsz.f, pgqwin.f, pgrect.f, pgsah.f, pgsch.f, pgscir.f, pgsfs.f, pgshs.f, pgsitf.f, pgstbg.f, pgsubp.f, pgsvp.f, pgswin.f, pgvsiz.f, pgvstd.f, pgvw.f, pgwnad.f Modified to allow multiple concurrent devices. pgclos.f (New routine.) Closes the currently selected graphics device. pginit.f (New internal routine.) Initialize PGPLOT (this is to avoid an illegal initialization of data in COMMON). pgopen.f (New routine.) Open (and select) a graphics device; unlike PGBEG, this does not close any previously opened device. pgqid.f (New routine.) Returns the identifier of the currently selected graphics device, for use with PGSLCT. pgslct.f (New routine.) Selects one of the open devices for graphics output. pgqinf.f Changed version number to 5.1.0. pgshs.f Added checks on validity of arguments. pgplot/sys_* Changes to configuration files to support compilation of the Motif driver and example programs. pgplot/sys_arc Contents of directory updated for version 5.1.0 by Dave Crennell. See file AAAREADME. pgplot/sys_linux The current version of gcc does not require system-specific variants of any files. The variants for f2c have been moved into a subdirectory pgplot/sys_linux/f77_src and the configuration files have been modified accordingly. pgplot/sys_mac Contents of directory updated for version 5.0.3 by J. S. Salmento. See file aaaread.me. pgplot/sys_msdos Contents of directory updated for version 5.1.0 by C. T. Dum. See file aaaread.me. pgplot/sys_next Contents of directory updated for version 5.1.0 and NeXtStep 3.0 by Allyn Tennant. Configuration file for GNU Fortran (g77) added. See file aaaread.me. pgplot/sys_sol2 Added -R options to the ld commands in the configuration files; these help the demo programs to find the PGPLOT shared library at run time (assuming you haven't moved it after compilation.) pgplot/sys_sun4 Changed version number from 1.7 to 1.8 in all .conf files. pgplot/sys_vms build.com, compile.com Added new routines to shared library transfer vector. Added instructions for linking with Motif library when needed. grlgtr.f This routine formerly converted all PGPLOT device specifications to uppercase for VMS. It now preserves case (VMS file and device names are not case-sensitive, but some PGPLOT device specifications can be). install.com Added new target (pgmdemo) to compile/install the Motif demonstration program. make_cpg.com Corrected to use the version of cpgplot.h in the current directory; set correct protection on generated files. make_pgdisp.com Changed name of directory from PGDISP to PGDISPD. make_pgmdemo.com (New file.) Used in compilation of the Motif example program. pgplot/sys_win New directory: from Phil Seeger. Port of version 5.1.0 to MS PowerStation Fortran/Windows95 (or WindowsNT) environment. See file aaaread.me. ---------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1996 California Institute of Technology cpgplot.h Deleted file (note that this file needs to be created as part of the installation). pgbind.c Added C++ wrapper to the generated cpgplot.h file. Added support for const qualified declarations in the function prototypes. pgplpgplot/copyright.notice010064400040640000322000000052610724652035100157550ustar00tjpcitmbr00000400000017*********************************************************************** * PGPLOT Fortran Graphics Subroutine Library * * Version 5.2.2 * *********************************************************************** *********************************************************************** * * * Copyright (c) 1983-2001 by the California Institute of Technology. * * All rights reserved. * * * * For further information, contact: * * Dr. T. J. Pearson * * 105-24 California Institute of Technology, * * Pasadena, California 91125, USA * * * * tjp@astro.caltech.edu * * * * The PGPLOT library, both binary and source, and the PGPLOT manual * * `PGPLOT Graphics Subroutine Library' are copyrighted, but available * * without fee for education, academic research and non-commercial * * purposes. Ownership of the software remains with the California * * Institute of Technology. Users may distribute the binary and * * source code to third parties provided that the copyright notice and * * this statement appears on all copies and that no charge is made for * * such copies. Any entity wishing to integrate all or part of the * * source code into a product for commercial use or resale should * * contact the author at the above address. * * * * THE CALIFORNIA INSTITUTE OF TECHNOLOGY MAKES NO REPRESENTATIONS * * ABOUT THE SUITABILITY OF THE SOFTWARE FOR ANY PURPOSE. IT IS * * PROVIDED `AS IS' WITHOUT EXPRESS OR IMPLIED WARRANTY. THE * * CALIFORNIA INSTITUTE OF TECHNOLOGY SHALL NOT BE LIABLE FOR ANY * * DAMAGES SUFFERED BY THE USER OF THIS SOFTWARE. * * * * The software may have been developed under agreements between the * * California Institute of Technology and the Federal Government which * * entitle the Government to certain rights. * * * *********************************************************************** pgplot/aaaread.me010064400040640000322000000030060724652051000144330ustar00tjpcitmbr00000400000017 PGPLOT v5.2.2 ------------- For further information, look at the following files in this directory: install.txt Installation instructions ver500.txt What's new in version 5.0.0 ver501.txt What's changed between 5.0.0 and 5.0.1 ver502.txt What's changed between 5.0.1 and 5.0.2 ver503.txt What's changed between 5.0.2 and 5.0.3 ver510.txt What's changed between 5.0.3 and 5.1.0 ver511.txt What's changed between 5.1.0 and 5.1.1 ver520.txt What's changed between 5.1.1 and 5.2.0 ver521.txt What's changed between 5.2.0 and 5.2.1 ver522.txt What's changed between 5.2.1 and 5.2.2 copyright.notice Read this! ======================================================================== PGPLOT Version 5.2.2 Version 5.2.2 of the PGPLOT Graphics Subroutine Library was released on 2001 Feb 26. The new version is available by anonymous ftp from ftp://astro.caltech.edu/pub/pgplot/ PGPLOT is distributed as a gzip'd tar file (pgplot5.2.tar.gz). Utilities to decode such files are available for most internet-enabled operating systems. Complete documentation for PGPLOT is available through the World-Wide Web at http://astro.caltech.edu/~tjp/pgplot/ To remove your name from my mailing list, or to add another one, send e-mail to the undersigned. Tim Pearson Dept 105-24, Caltech, Pasadena, California 91125, USA Internet: tjp@astro.caltech.edu, Pearson_T@caltech.edu WWW: http://astro.caltech.edu/~tjp/ Telephone: +1 626 395-4980 FAX: +1 626 568-9352 PGPLOT v5.2.2 ------------- For further information, look at the following files in this directory: install.txt Installation instructions ver500.txt What's new in version 5.0.0 ver501.txt What's changed between 5.0.0 and 5.0.1 ver502.txt What's changed between 5.0.1 and 5.0.2 ver503.txt What's changed between 5.0.2 and 5.0.3 ver510.txt What's changed between 5.0.3 and 5.1.0 ver511.txt What's changed between 5.1.0 and 5.1.1 ver520.txt What'spgplot/ver503.txt010064400040640000322000000205410606561474200143330ustar00tjpcitmbr00000400000017PGPLOT version 5.0.3 Tested Systems Version 5.0.3 has been tested with the following operating systems and compilers. Drivers tested include: GI, GL, NU, PP, PS, TT, VT, WD, X2, XW (but not all combinations of drivers and systems have been tested exhaustively). * HP-UX version A.09.01, HP Fortran/9000 (fort77), HP C (c89). * OpenVMS AXP V6.1, DEC FORTRAN V6.2, DEC C V4.0 (tested on DEC 3000/M600). * OpenVMS VAX V6.1, DEC FORTRAN V6.2, DEC C V4.0 (tested on VAXstation 4000-90). Note: the PGDISP server cannot be compiled on this system. * Solaris 2.4 (SunOS 5.4), Sun Fortran 2.0.1, Sun C 2.0.1 (tested on SPARCstation 10). * SunOS 4.1.4, Sun Fortran 1.3.1, cc (tested on SPARCstation IPX). Note: the C-binding cannot be compiled with this non-ANSI C compiler. * SunOS 4.1.4, Sun Fortran 1.3.1, GNU gcc v2.7.0 (tested on SPARCstation IPX). Changes in Version 5.0.3 Routine PGQCS has a new option to determine the character height in world coordinates, and a bug that would give wrong values on devices with non-square pixels has been corrected. Routine PGTBOX has a new option `X' to label the HH field modulo 24. Thus, a label such as 25h 10m would come out as 1h 10m. Graphical output from the GIF and PPM drivers can now be directed to the standard output by specifying a file name ``-'', e.g., ``-/gif''. This allows output to be piped to a viewing program, e.g., ``pgprog | xv -''. This will only work for single-page plots. In this version I have started work to change the character coding of PGPLOT text strings from US-ASCII to ISO Latin-1. Unfortunately I do not have digitized versions of most of the required glyphs, so this work is not complete. Programs which use characters with decimal codes in the range 128-255 will now display differently: in most cases, the glyph will be an approximation to the ISO Latin-1 character (e.g., an unaccented letter instead of the correctly accented one). A new escape sequence, \., has been added for a centered dot (·). A bug has been fixed that affected PostScript and possibly some other drivers: they would ignore a change to the color-representation of the currently selected color index. Some changes have been made in the way PGPLOT writes BoundingBox comments in PostScript files. Two bugs in polygon fill have been fixed: PGPOLY would issue an error message about a polygon with less than 3 vertices on some occasions when a polygon was completely outside the viewport; and polygon fill was ignored completely on some devices if the y-axis ran downwards instead of upwards. There is one new driver (HGDRIV), for HP-GL/2 devices. Minor corrections have been made in several other subroutines and text files. ------------------------------------------------------------------------------- pgplot aaaread.me Changed version number to 5.0.3. copyright.notice Changed version number to 5.0.3. drivers.list Added HGDRIV. install.txt Updated. makehtml This is a perl script used for making the html documentation file. Some systems had trouble executing this script. I have now modified it to invoke perl by the #! mechanism. You may have to modify the first line of the script to specify the location of perl on your system. makemake Now includes the ``non-standard'' routines in the documentation files (pgplot.doc, pgplot.html). Also modified the non-standard routines to get cross-references to their aliases in the HTML file. The list of include file dependencies is now generated by searching the code. Special code for the Motif widget has been added. Added HGDRIV. ver503.txt (New file.) Release notes. pgplot/drivers hgdriv.f (New file.) Driver from Colin J. Lonsdale for HP-GL/2 devices. I have not tested this. It is an alternative to GLDRIV: you should probably not include both in your PGPLOT configuration. lxdriv.f Removed a non-standard DATA initialization. psdriv.f Changed interpretation of environment variables PGPLOT_PS_BBOX and PGPLOT_PS_DRAW_BBOX; see the documentation. xwdriv.c Fix an error in display of large images. gidriv.f, ppdriv.f, wddriv.f Added comments to indicate what must be changed on operating systems like OSF/1 that use 64-bit addresses. pgplot/examples pgdemo1.f Fixed error in scatter plot, and rewrote random number routines. pgdemo2.f Exercise a few more escape sequences. pgplot/src grdtyp.f, grldev.f Changed to totally ignore a PGPLOT driver that reports a zero-length device type. This is to allow for stub drivers (more to come on this). grfa.f Fix bug: polygon fill was ignored on devices for which fill must be emulated in PGPLOT if the y-axis was reversed. grfa.f, grrec0.f Changed to avoid use of a real variable as a do-loop index (not allowed by some compilers). grscr.f Fix bug that affected some drivers: if you change the color representation of the current color, these drivers did not notice. grsyds.f Changed to allow 304 = 256+48 characters in a font rather than 128+48 (the `48' are the greek characters). Added \. escape sequence. grsymk.f Changed to allow 304 = 256+48 characters in a font rather than 128+48. This is in preparation for using the ISO-Latin-1 character set rather than US-ASCII. Unaccented glyphs have been assigned for most of the ISO-Latin-1 accented characters. pgcl.f Under rare circumstances could crash with both arguments to atan2 equal to zero. [This is an internal routine used by PGCONL]. pgpoly.f Fixed a bug in the clipping algorithm that affected some polygons that lie entirely outside the viewport. pgqcs.f Added option UNITS=4 to determine the character height in world coordinates, and fixed a bug that would give wrong values on devices with non-square pixels. pgqhs.f Corrected comments (arguments are output, not input). pgqinf.f Changed version number to 5.0.3. Changed cursor test to determine whether the driver reports a cursor, rather than assuming that all interactive devices have cursors. pgtbox.f New option `X' to label the HH field modulo 24 [Neil Killeen]. pgimag.f Minor changes to header comments. pgswin.f, pgwnad.f These routines now check whether a window of zero width or zero height has been requested, in order to prevent a nasty divide-by-zero error. pg*.f (many files) Many of the top-level PG routines have been modified to issue a warning message (by calling PGNOTO) if no device is open. This is in preparation for multiple open devices. pgplot/sys grfileio.c Recognize file name ``-'' as standard output. pgplot/sys_dos msdriv.f Revised device driver for PCs running DOS with Microsoft Fortran 5.0, from Harry Lehto. This replaces msdriv.f, msdriv.koyama, and msdriv.lehto. pgplot/sys_linux aaaread.me Add notes on use of Gnu g77 compiler [Brian Toby]. g77_gcc.conf (New file.) Configuration file for Gnu g77 compiler [Brian Toby]. pgplot/sys_mac (New directory.) Macintosh OS, LS Fortran 2.1. See file aaaread.me. pgplot/sys_msdos aaaread.me Added information about a serious bug in the Microsoft Powerstation Fortran compiler [from C. T. Dum]. pgplot/sys_osf1 aaaread.me Added notes about the 64-bit address problem: some PGPLOT device drivers must be modified to be used with this operating system. grgmem.c This is a variant of pgplot/sys/grgmem.c that returns the pointer as an INTEGER*8 (64-bit-address). pgplot/sys_sun4 *.conf Changed shared library version number from 1.6 to 1.7. pgplot/sys_vms grfileio.c Now recognizes file name ``-'' as standard output. ------------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1995 California Institute of Technology pgplot/maketex010075500040640000322000000053150613501313400141160ustar00tjpcitmbr00000400000017#!/usr/local/bin/perl $, = ' '; # set output field separator $\ = "\n"; # set output record separator @files = @ARGV; print <<'EOD'; \documentstyle[twoside]{report} \raggedbottom \pagestyle{headings} \begin{document} \appendix \chapter{Subroutine Descriptions} \section{Introduction} This appendix includes a list of all the PGPLOT subroutines, and then gives detailed instructions for the use of each routine in Fortran programs. The subroutine descriptions are in alphabetical order. \section{Arguments} The subroutine descriptions indicate the data type of each argument. When arguments are described as ``input'', they may be replaced with constants or expressions in the {\tt CALL} statement, but make sure that the constant or expression has the correct data type. \begin{description} \item[{\tt INTEGER} arguments] should be declared {\tt INTEGER} or {\tt INTEGER*4} in the calling program, not {\tt INTEGER*2}. \item[{\tt REAL} arguments] should be declared {\tt REAL} or {\tt REAL*4} in the calling program, not {\tt REAL*8} or {\tt DOUBLE PRECISION}. \item[{\tt LOGICAL} arguments] these should be declared {\tt LOGICAL} or {\tt LOGICAL*4} in the calling program. \item[{\tt CHARACTER} arguments] may be any valid Fortran {\tt CHARACTER} variable (declared {\tt CHARACTER*n} for some integer {\tt n}). \end{description} \section{Index of Routines} EOD # Extract documentation from pgplot source code: output index of routines print '\begin{description}'; while (<>) { chop; # strip record separator if (/^C\*/) { ($module, $rest) = split (' ', $_, 2); $module = substr($module, 2); print "\\item[$module] $rest"; $ref{$module} = "$module"; push (@modules, $module); } } # reverse sort so that modules with the same first few characters occur # longest to shortest. @modules = sort {length($b) <=> length($a)} @modules; print '\end{description}'; print ' '; print '{\small'; print '\hrule'; # Extract documentation from pgplot source code: output LaTeX code @ARGV = @files; while (<>) { /^C\*/ && do { print ''; print ''; chop; ($module, $rest) = split (' ', substr($_, 2), 2); print "\\subsection*{$module $rest \}"; next; }; /^C\+/ && do { print '\begin{verbatim}' if $echo == 0; $echo = 1; print &Getline0(); next; }; /^C--/ && do { print '\end{verbatim}' if $echo == 1; print '\hrule' if $echo == 1; $echo = 0; next; }; next if ! $echo; /^C/ && do { chop; print substr($_, 2) if $echo == 1; next; }; chop; print; } print <<'EOD'; } \end{document} EOD sub Getline0 { if ($getline_ok = (($_ = <>) ne '')) { chop; # strip record separator } $_; } pgplot/ver511.txt010064400040640000322000000166360623744344400143440ustar00tjpcitmbr00000400000017PGPLOT version 5.1.1 Tested Systems Version 5.1.1 has been tested with the following operating systems and compilers. Drivers tested include: GI, GL, NU, PP, PS, TT, VT, WD, X2, XM, XW (but not all combinations of drivers and systems have been tested exhaustively). * SunOS 4.1.3_U1, Sun Fortran (f77) 1.3.1, GNU C (gcc) 2.7.0 (tested on SPARC 5). * Solaris 2.5 (SunOS 5.5), Sun Fortran (f77) 3.0.1, Sun C (cc) 3.0.1 (tested on SPARC IPX). * Solaris 2.5 (SunOS 5.5), Sun Fortran (f77) 3.0.1, GNU C (gcc) 2.7.2 (tested on SPARC IPX, SPARC Ultra-1). * OpenVMS AXP V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.1 (tested on DEC 3000/M600). * OpenVMS VAX V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.2 (tested on VAXstation 4000-90). Changes in Version 5.1.1 All changes are bug fixes or minor improvements. The most notable bug fixes are: * PGOPEN, PGBEG: a device specification like '? ' (question mark with one or more trailing spaces) causes PGOPEN to issue a blank prompt for device specification. This was an unintended change in 5.1.0, and has been fixed in version 5.1.1. * PGBEG: in version 5.1.0, the ordering of panels changed from row order to column order. The way the sign of the NXSUB argument was interpreted was precisely the opposite of the documented interpretation (NXSUB > 0 should give row order, and < 0 should give column order). PGSUBP has always been wrong, but PGBEG acquired the incorrect behavior in version 5.1.0. Both PGBEG and PGSUBP now behave as documented. * The PostScript driver was ignoring environment variables used to set the paper size. It now recognizes these variables. In addition, it will accept requests via routine PGPAP to change the paper size, even if the size requested is larger than the default size. (You can still set the default size with environment variables PGPLOT_PS_WIDTH and PGPLOT_PS_HEIGHT.) There are two side-effects of this change: (1) When PGPAP is used, a portrait-mode graph is placed in the lower left corner of the paper (offset by the amount specified by environment variables PGPLOT_PS_HOFFSET and PGPLOT_PS_VOFFSET; a landscape-mode graph is placed in the same corner of the paper, but in this case it appears to be the top left corner! (2) When PGPAP is used, the bounding-box cannot be guessed when the file is opened, so you should not use the PGPLOT_PS_BBOX environment variable; if you do not set this variable, a correct bounding box will be written in the file trailer (see the discussion in the note on the PostScript printer driver). List of Changes pgplot aaaread.me Revised for version 5.1.1. copyright.notice Version number changed. makemake It now issues a message encouraging the installer to read the appropriate README file. ver511.txt [new file] List of changes (this file). pgplot/drivers psdriv.f Bug fixes: PGPLOT_PS_HOFFSET and PGPLOT_PS_VOFFSET were not decoded correctly (bug introduced in v5.1.0); bounding box could be incorrect (probably only on systems with non-static allocation of Fortran variables). Driver now honors all requests to change the paper size with PGPAP. Optimization: suppressed attempts to draw zero-length continuation line segments (thanks to Remko Scharroo). vtdriv-vms.f This is an alternative to vtdriv.f. It uses VMS-specific Fortran, but may work better than vtdriv.f on VMS systems. xwdriv.c, pgxwin_server.c Bug fix: images were displayed incorrectly on (some?) X-servers with more than 8 bits per pixel. pgplot/examples pgdemo2.f Added example of Cyrillic text on page 3. pgplot/src grdtyp.f, grpars.f Bug fix: improved minmatch routine for device types to allow, e.g., /HPGL even if /HPGL2 is also an option. grpocl.f Bug fix: (this is a support routine for polygon fill with PGPOLY, etc.) A polygon with one vertex exactly aligned with the edge of the window was not clipped correctly (thanks to Remko Scharroo for the bug fix). pgopen.f Bug fix and improvement in header comments. V5.1.0 introduced a bug: a device argument of '? ' with one or more trailing spaces did not issue the correct prompt. pgqinf.f Change version to 5.1.1. pgsave.f Correction in header comments. pgsubp.f This routine was interpreting a negative NXSUB argument incorrectly. According to the documentation, positive NXSUB should step through the panels in row order, while negative NXSUB should step through them in column order; but the routine was interpreting positive NXSUB as column order and negative as row order. The behavior has been corrected to match the documentation. (In version 5.1.0, pgbeg was changed to call pgsubp, thus introducing this bug in pgbeg as well.) pgtbox.f The positioning of labels relative to the axis has been improved; the displacement of labels from the axis should now be the same as in PGBOX. Problems were most noticeable when a large character size was requested. (Thanks to Neil Killeen for the fix.) pgvect.f The routine was ignoring the first row and column of the array when finding the scale-factor for the vector length. (Thanks to David Singleton for pointing this out.) pgplot/sys_arc F77/ACDriver Revised to allow a concurrent hardcopy device (Dave Crennell). F77/GRexecAC Correct typo (Dave Crennell). pgplot/sys_fujitsu This new directory replaces sys_vp2200. The files are from David Singleton. aaaread.me Revised. uxpm_frt_cc.conf Configuration file for Fujitsu UXP/M, frt FORTRAN compiler and /usr/ucb/cc compiler. uxpv_frt_cc.conf Configuration file for Fujitsu UXP/V, frt FORTRAN compiler and /usr/ucb/cc compiler. pgplot/sys_hp *.conf Added support for compiling the Motif driver (xmdriv) [mcs]. pgplot/sys_linux aaaread.me Added notes on Linux variants and problems. g77_elf.conf [new file] Configuration file for Linux systems that use ELF binaries. pgplot/sys_sol2 aaaread.me Added notes about use of Sun f90 compiler and GNU g77 compiler. Added note about problem with the ucb version of "ld". f90_cc.conf [new file] For Solaris f90 1.1 Fortran compiler (from Ricardo Piriz). g77_gcc.conf [new file] For GNU g77 Fortran compiler (with gcc). pgplot/sys_vp2200 Directory removed. pgplot/sys_vms aaaread.me [new file] Includes some notes on incompatibilities between versions of Motif, C compiler, and VMS. grlgtr.f This has been rewritten: it now treats logical names as case-insensitive, and uses $TRNLNM instead of obsolete $TRNLOG. makedoc.com [new file] A DCL command procedure to extract the documentation from the source code. ---------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1996 California Institute of Technology ice specification like '? ' (question mark with one or more trailing spaces) causes PGOPEN topgplot/ver520.txt010064400040640000322000000156540635127412600143370ustar00tjpcitmbr00000400000017PGPLOT version 5.2.0 This version includes bug fixes, improvements in existing routines, new routines, and new device drivers. All changes are intended to be compatible: existing programs should run unchanged and produce the same output (except for a few bug fixes). Tested Systems Version 5.2.0 has been tested with the following operating systems and compilers. Drivers tested include: GI, GL, NU, PG, PP, PS, TT, TK, VT, WD, X2, XM, XW (but not all combinations of drivers and systems have been tested exhaustively). * Solaris 2.5.1 (SunOS 5.5.1), Sun Fortran (f77) 3.0.1, Sun C (cc) 3.0.1 (tested on SPARC Ultra-1) [sol2 f77_cc]. * Solaris 2.5.1 (SunOS 5.5.1), GNU Fortran (g77) 0.5.18, GNU C (gcc) 2.7.2.1 (tested on SPARC Ultra-1) [sol2 g77_gcc]. * SunOS 4.1.3, Sun Fortran (f77), GNU C (gcc) (tested on Sun SPARCStation 2) [sun4 f77_gcc]. * OpenVMS AXP V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.1 (tested on DEC 3000/M600). * OpenVMS VAX V6.1, DEC FORTRAN V6.2, DEC C V4.0, DECwindows Motif 1.2 (tested on VAXstation 4000-90). New PGPLOT routines The following routines are documented in the list of subroutines, and will be explained more fully in the manual. pgaxis Draw a linear or logarithmic axis (more options will be added in later versions). pgconf Shade area between two contours. pgerr1 Draw a single error bar (useful for systems which cannot pass a scalar to a routine that expects an array). pgpt1 Draw a single graph marker (useful for systems which cannot pass a scalar to a routine that expects an array). pgsclp, pgqclp Set/query clipping status (used by PGBOX and PGAXIS to ensure that axes are not clipped against the viewport). pgqdt, pgqndt Inquiry routines used to determine the list of device types available in a PGPLOT installation; useful for building menus, etc. pgscrl Scroll a rectangular region of the screen; useful for making animated displays without redrawing the whole screen; currently only supported on X Window and related devices. pgtick Used by pgaxis to draw single labelled tick mark; may be called directly, e.g., for special non-linear axes. Modified PGPLOT routines Internal changes that do not affect the API are not listed. Several routines have been modified to improve their descriptions or improve speed. pgctab The behavior of the arguments "brightness" and "contrast" has been changed slightly. The color indices set by this routine will be slightly changed from earlier versions of PGPLOT, except when these arguments have their "default" values (0.5 and 1.0). The routine is designed for use in an interactive environment in which the user can explore the effect of changing these parameters; in the new version they behave somewhat more as one might expect. pgqinf Added ability to determine whether a device supports pgscrl. New device drivers pgdriv (device type /PGMF) Creates a disk file in a private PGPLOT Metafile format. This is a portable file format using only printable ASCII characters. It is intended to replace the old metafile (created by MFDRIV) which uses a binary, machine-dependent format. Subroutines are being prepared to allow a PGPLOT program to read and display files written in this format (an example program is provided in directory pgplot/pgmf). The driver uses only standard Fortran-77 and so should be portable to all operating systems on which PGPLOT is supported. tkdriv (device type /XTK) For plotting in PGPLOT TCL/Tk widgets under the X Window System (UNIX systems only). An example program is included. Feedback on this driver would be appreciated: send e-mail to Martin Shepherd (mcs@astro.caltech.edu). Modified device drivers lxdriv LaTeX picture environment driver. Fixed bug: picture size can now be adjusted with PGPAP. (Note: The PostScript driver gives much better results than this one, if your LaTeX environmant allows PostScript files to be included in LaTeX documents.) xmdriv Motif widget driver. Added support for scrolling; improved cursor handling; bug fixes. xwdriv X Window driver. Added support for scrolling; bug fixes. The PGPLOT cursor can now be moved horizontally and vertically with the keyboard arrow keys, which can be more precise than using the mouse. Each keystroke moves the cursor by one pixel, or 10 pixels if the SHIFT key is depressed. Deprecated drivers The following drivers are probably no longer useful, and their use is discouraged. They have been moved from pgplot/drivers to pgplot/drivers/old. If you still need any of these drivers, please contact Tim Pearson. imdriv, vidriv Imagen printers. irdriv Silicon Graphics workstations: use the X-window drivers instead. svdriv Sun workstations running SunView: use the X-window drivers instead. Changes to installation procedures The installation instructions have been rewritten. There are two changes you should be aware of: 1. All the UNIX configuration files (pgplot/sys_*/*.conf) have been modified to add new parameters that may be required for the new widget drivers. If you have made modifications to configuration files and haven't sent them back to Tim Pearson, you will need to change them again. 2. If you need to modify a configuration file for your system, it is now recommended that you make a new configuration file called "local.conf" in the build directory, by editing a configuration file for a related system. makemake will now read this file if you do not specify a configuration on the makemake command line. New and modified demonstration programs pgdemo1 Now uses new routine pgpt1 when a single marker is to be drawn. pgdemo2 Modified text-sample page. pgdemo3 Added demo of new routine pgconf. Demo of pgvect has been moved to pgdemo15. pgdemo4 Demo of pgimag: modified to use slightly more realistic transformation matrices, to show the use of pgctab, and to show how the color palette may be modified interactively. pgdemo6 Now uses new routine pgpt1 when a single marker is to be drawn. pgdemo13 Now uses new routine pgpt1 when a single marker is to be drawn. pgdemo15 New demo for routine pgvect (formerly in pgdemo3). pgdemo16 New demo for bar and column charts. This uses a general-purpose subroutine that may get included in a future version of pgplot, although not exactly in this form. pgdemo17 New demo, from Dr Martin Weisser, showing animated rotation of a molecular structure. Changes to C binding The program that creates the PGPLOT C binding (pgbind) can now generate a binding for MS-Powerstation (Windows). ---------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1997 California Institute of Technology pgplot/sys_win/grdos.f010064400040640000322000000175430654622037300155330ustar00tjpcitmbr00000400000017C*GRDATE -- get date and time as character string (Fortran90) C+ SUBROUTINE GRDATE(CDATE, LDATE) CHARACTER CDATE*(17) INTEGER LDATE C C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'. C To receive the whole string, the CDATE should be declared C CHARACTER*17. C C Arguments: C CDATE : receives date and time, truncated or extended with C blanks as necessary. C L : receives the number of characters in STRING, excluding C trailing blanks. This will always be 17, unless the length C of the string supplied is shorter. C-- C 1989-Mar-17 - [AFT] C 12/1993 C. T. Dum MS Power Station F32 Version C 1996-Apr-16 - Fortran 90 version [P.A.Seeger] C----------------------------------------------------------------------- CHARACTER CMON(12)*3 INTEGER II(8) DATA CMON/'Jan','Feb','Mar','Apr','May','Jun', & & 'Jul','Aug','Sep','Oct','Nov','Dec'/ C--- CALL DATE_AND_TIME(VALUES=II) WRITE(CDATE,111) II(3),CMON(II(2)),II(1),II(5),II(6) 111 FORMAT(I2,'-',A3,'-',I4,' ',I2,':',I2) LDATE = 17 RETURN END C*GRFLUN -- free a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRFLUN(LUN) INTEGER LUN C C Free a Fortran logical unit number allocated by GRGLUN. C C Arguments: C LUN : the logical unit number to free. C-- C 22-Apr-1996 [PAS] C----------------------------------------------------------------------- CLOSE (LUN) RETURN END C*GRGCOM -- read with prompt from user's terminal (Fortran 90) C+ INTEGER FUNCTION GRGCOM(CREAD, CPROM, LREAD) CHARACTER CREAD*(*), CPROM*(*) INTEGER LREAD C C Issue prompt and read a line from the user's terminal; in VMS, C this is equivalent to LIB$GET_COMMAND. C C Arguments: C CREAD : (output) receives the string read from the terminal. C CPROM : (input) prompt string. C LREAD : (output) length of CREAD. C C Returns: C GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file). C-- C 1989-Mar-29 ctd 3/95:len_trim (MS Fortran/Fortran 90) C----------------------------------------------------------------------- INTEGER IER C--- 11 FORMAT(A) C--- GRGCOM = 0 LREAD = 0 WRITE (*, 101, IOSTAT=IER) CPROM 101 FORMAT(1X,A,\) IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CREAD IF (IER.EQ.0) GRGCOM = 1 LREAD = LEN_TRIM(CREAD) RETURN END C*GRGENV -- get value of PGPLOT environment parameter (Win95) C+ SUBROUTINE GRGENV(CNAME, CVALUE, LVALUE) USE MSFLIB CHARACTER CNAME*(*), CVALUE*(*) INTEGER LVALUE C C Return the value of a PGPLOT environment parameter. C C Arguments: C CNAME : (input) the name of the parameter to evaluate. C CVALUE : receives the value of the parameter, truncated or extended C with blanks as necessary. If the parameter is undefined, C a blank string is returned. C LVALUE : receives the number of characters in CVALUE, excluding C trailing blanks. If the parameter is undefined, zero is C returned. C-- C 1990-Mar-19 - [AFT] C 12/93;3/95 CTD F32 C 16-Apr-1996 - Win95, F90 (MSFLIB, LEN_TRIM) [P.A.Seeger] C----------------------------------------------------------------------- C CHARACTER*80 CTMP,CTEMP CTMP = 'PGPLOT_'//CNAME LVALUE = GETENVQQ(CTMP(:LEN_TRIM(CTMP)),CTEMP) IF(LVALUE .NE. 0) THEN CVALUE = CTEMP(:LVALUE) ELSE CVALUE = ' ' END IF RETURN END C*GRGLUN -- get a Fortran logical unit number (MS-DOS) C+ SUBROUTINE GRGLUN(LUN) INTEGER LUN C C Get an unused Fortran logical unit number. C Returns a Logical Unit Number that is not currently opened. C After GRGLUN is called, the unit should be opened to reserve C the unit number for future calls. Once a unit is closed, it C becomes free and another call to GRGLUN could return the same C number. Also, GRGLUN will not return a number in the range 1-9 C as older software will often use these units without warning. C C Arguments: C LUN : receives the logical unit number C-- C 12-Feb-1989 [AFT/TJP]. C 22-Apr-1996: count upward from 11 [PAS] C----------------------------------------------------------------------- INTEGER I LOGICAL QOPEN C--- I = 10 QOPEN = .TRUE. DO WHILE (QOPEN) I = I+1 INQUIRE (UNIT=I, OPENED=QOPEN) END DO LUN = I RETURN END C*GRLGTR -- translate logical name (MS-DOS) C+ SUBROUTINE GRLGTR (CNAME) CHARACTER CNAME*(*) C C Recursive translation of a logical name. C Up to 20 levels of equivalencing can be handled. C This is used in the parsing of device specifications in the C VMS implementation of PGPLOT. In other implementations, it may C be replaced by a null routine. C C Argument: C CNAME (input/output): initially contains the name to be C inspected. If an equivalence is found it will be replaced C with the new name. If not, the old name will be left there. The C escape sequence at the beginning of process-permanent file C names is deleted and the '_' character at the beginning of C device names is left in place. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CH*1 CH = CNAME(1:1) RETURN END C*GROPTX -- open output text file [MS-DOS] C+ INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE) INTEGER UNIT,MODE CHARACTER*(*) NAME,DEFNAM C C Input: C UNIT : Fortran unit number to use C NAME : name of file to create C DEFNAM : default file name (used to fill in missing fields for VMS) C C Returns: C 0 => success; any other value => error. C----------------------------------------------------------------------- INTEGER IER CHARACTER CH*1 CH = DEFNAM(1:1) IER = MODE OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER) GROPTX = IER RETURN C----------------------------------------------------------------------- END C*GRTRML -- get name of user's terminal (MS-DOS) C+ SUBROUTINE GRTRML(CTERM, LTERM) CHARACTER CTERM*(*) INTEGER LTERM C C Return the device name of the user's terminal, if any. C C Arguments: C CTERM : receives the terminal name, truncated or extended with C blanks as necessary. C LTERM : receives the number of characters in CTERM, excluding C trailing blanks. If there is not attached terminal, C zero is returned. C-- C 1989-Nov-08 C----------------------------------------------------------------------- CTERM = 'CON' LTERM = 3 RETURN END C*GRTTER -- test whether device is user's terminal (MS-DOS) C+ SUBROUTINE GRTTER(CDEV, QSAME) CHARACTER CDEV*(*) LOGICAL QSAME C C Return a logical flag indicating whether the supplied device C name is a name for the user's controlling terminal or not. C (Some PGPLOT programs wish to take special action if they are C plotting on the user's terminal.) C C Arguments: C CDEV : (input) the device name to be tested. C QSAME : (output) .TRUE. is CDEV contains a valid name for the C user's terminal; .FALSE. otherwise. C-- C 18-Feb-1988 C----------------------------------------------------------------------- CHARACTER CTERM*64 INTEGER LTERM C CALL GRTRML(CTERM, LTERM) QSAME = (CDEV.EQ.CTERM(:LTERM)) RETURN END C*GRUSER -- get user name (MS-DOS) C+ SUBROUTINE GRUSER(CUSER, LUSER) CHARACTER CUSER*(*) INTEGER LUSER C C Return the name of the user running the program. C C Arguments: C CUSER : receives user name, truncated or extended with C blanks as necessary. C LUSER : receives the number of characters in VALUE, excluding C trailing blanks. C-- C 1989-Mar-19 - [AFT] C----------------------------------------------------------------------- C CALL GRGENV('USER', CUSER, LUSER) RETURN END pgplot/sys_win/grexec.f010064400040640000322000000030300654622037300156540ustar00tjpcitmbr00000400000017C*GREXEC -- PGPLOT device handler dispatch routine C 12/93 C. T. Dum: version for MS F32 Power Station C 20-Apr-1996: "W9DRIV", use CASE structure [PAS] C 10-Jul-1996: add GIF driver (already had PostScript, Null, LaTex) [PAS] C+ SUBROUTINE GREXEC(IDEV, IFUNC, RBUF, NBUF, CHR, LCHR) INTEGER IDEV, IFUNC, NBUF, LCHR REAL RBUF(*) CHARACTER*(*) CHR C--- INTEGER NDEV PARAMETER (NDEV=13) CHARACTER*10 MSG C--- SELECT CASE (IDEV) CASE (0) RBUF(1) = NDEV NBUF = 1 CHR = ' ' LCHR = 0 CASE (1) CALL W9DRIV(IFUNC,RBUF,NBUF,CHR,LCHR,0) CASE (2) CALL W9DRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) CASE (3) CALL W9DRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) CASE (4) CALL W9DRIV(IFUNC,RBUF,NBUF,CHR,LCHR,3) CASE (5) CALL W9DRIV(IFUNC,RBUF,NBUF,CHR,LCHR,4) CASE (6) CALL NUDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) CASE (7) CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) CASE (8) CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) CASE (9) CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,3) CASE (10) CALL PSDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,4) CASE (11) CALL GIDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,1) CASE (12) CALL GIDRIV(IFUNC,RBUF,NBUF,CHR,LCHR,2) CASE (13) CALL LXDRIV(IFUNC,RBUF,NBUF,CHR,LCHR) CASE DEFAULT WRITE (MSG,'(I10)') IDEV CALL GRQUIT('Unknown device code in GREXEC: '//MSG) END SELECT RETURN END pgplot/sys_win/w9driv.f010064400040640000322000000530650654622037400156410ustar00tjpcitmbr00000400000017C* W9DRIV -- PGPLOT device driver for Windows95 (or WindowsNT) C+ SUBROUTINE W9DRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) USE DFLIB IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER CHR*(*) C C PGPLOT driver for IBM PC's and clones running DIGITAL Visual Fortran C (5.0 or higher). This driver will create a graphics window. C PGEND will return control to the default (text) window, but the graphics C window is not erased until is pressed. C C This routine must be compiled and linked with the Digital DFLIB graphics C library. Application must be compiled as a "QuickWin Graphics" project type, C compiler command line option /MW. C C 1989-Nov-03 - (MSDRIV) Started work [AFT] C 1989-Apr-06 - Improved version [AFT] C 1991-Mar-13 - Added cursor routine [JHT] C 12/1993 C. T. Dum: Version for MS Fortran Power Station C 1996-Apr-26 - W9DRIV (Windows95/PowerStation 4.0 version): C resolution modes; interrupt driven mouse (cursor band modes); C rectangle fill; pixel lines [Phil Seeger, PASeeger@aol.com] C 1996-Apr-30 - multiple devices; return color representation [PAS] C 1996-May-03 - each window has its own resolution and palette [PAS] C 1997-Dec-15 - change USE statement from Microsoft to Digital [PAS] C 1998-May-04 - had only 7 windows instead of 8 [PAS] C 1998-Jun-22 - moved window initialization to be after open [ACLarson] C----------------------------------------------------------------------- C C Supported device: IBM PC's and compatibles with Windows95/NT; C requires VGA or higher graphics adapter C C Device type code: /W95 (also /WV, /WS, /WX, or /WZ) C C Modes: 1, VGA, 640 x 480 C 2, SVGA, 800 x 600 C 3, XGA, 1024 x 768 C 4, ZGA, 1280 x 1024 C 0, from PGPLOT_VIDEO environment parameter, or SVGA C The Default mode is 800 x 640 pixels (SVGA). Other resolution C modes are accessed by entering SET PGPLOT_VIDEO=VGA (640x480), C XGA (1024x768), or ZGA (1280x1024) in the AUTOEXEC.BAT file, or C by using alternate device type designations. The maximum allowed C mode is determined by the graphics card and the Windows95 driver. C C Color capability: Color indices 0-15 are set to the default values C of PGPLOT, and indices 16-235 default to a gray scale. Palettes C of up to 235 colors are saved for each of 8 possible device C windows. (20 colors are reserved for the system.) C NOTE: There are some peculiar graphics adapters out there, and C even more peculiar drivers. The default colors have been C tweeked to appear unique in either the upper 6 or the lower C 6 bits of each byte. If you don't like what you see, you C may modify the DATA statement for RGB16. It may also be C necessary to change PARAMETER CNORM from 255 to 63. C C Default device name: None (the device name, if specified, is ignored). C C View surface dimensions: Depends on monitor, typical 7.5x10 inches C C Resolution: Depends on graphics card and Windows95 driver. C C Input capability: Mouse position, must be followed by a keyboard key. C C File format: None. C C Obtaining hardcopy: via Windows95, "File/Print" menu choice. C----------------------------------------------------------------------- C Notes: C Up to MAXDEV "devices" may be open at once. ACTIVE is the number C of the currently selected device (1 if no devices are open). C STATE(i) is 0 if device i is not open, 1 if it is open but with C no current picture, or 2 if it is open with a current picture. C----------------------------------------------------------------------- EXTERNAL GRW900, GRW901 INTEGER MAXDEV REAL*4 CNORM PARAMETER (MAXDEV=8, CNORM=255.) TYPE (xycoord) XY C CHARACTER CMSG*10, WINTITLE*80 INTEGER MX(0:4), MY(0:4), MXX(MAXDEV), MXY(MAXDEV), MXC(MAXDEV),& & I, ACTIVE,IUNIT(MAXDEV), STATE(0:MAXDEV), NPIC(MAXDEV) INTEGER*4 IRGB, RGB(0:235,MAXDEV), RGB16(0:15), RGB236(0:235) INTEGER*2 I2STAT, I2X0, I2Y0, I2X1, I2Y1, DASHLINE(5), ICOLOR, & & CBITS(MAXDEV), IX(1), IY(1), IC(1) INTEGER*4 I4STAT, I4X, I4Y, IXREF, IYREF, BAND, EVENT, IBUF LOGICAL FIRST, QFIRST(MAXDEV), LPOS SAVE FIRST, QFIRST, ACTIVE, STATE, XY, MXX, MXY, MXC, IUNIT, RGB, & & ICOLOR, NPIC, MX, MY, DASHLINE, CBITS, RGB16 DATA FIRST, QFIRST, ACTIVE, STATE(0:MAXDEV)/ & & .TRUE., MAXDEV*.TRUE., 1, -1, MAXDEV*0/ DATA MX, MY/ 0, 640, 800, 1024, 1280, & & 0, 480, 640, 768, 1024/ DATA DASHLINE/#FFFF, #FF80, #FC30, #CCCC, #FCCC/ C C Following data statement provides unique colors on all tested adapters DATA RGB16(0:15)/0, #FFFFFF, #0000FF, #00FF00, #FF0000, #FFFF00, & & #FF00FF, #00FFFF, #005FFF, #00FFAA, #AAFF00, #FF9300, #FF0093, & & #5F00FF, #555555, #AAAAAA/ C C--- C Initialize first 16 RGB values and gray scale for all windows IF (FIRST) THEN FIRST = .FALSE. DO ICOLOR=0,15 DO I=1,MAXDEV RGB(ICOLOR,I) = RGB16(ICOLOR) END DO END DO IRGB = #020202 DO ICOLOR=16,235 IRGB = IRGB + #010101 DO I=1,MAXDEV RGB(ICOLOR,I) = IRGB END DO END DO ICOLOR = 1 DO I=1,MAXDEV CBITS(I) = #0F END DO END IF C SELECT CASE (IFUNC) C CASE (1) C--- IFUNC = 1, Return device name.------------------------------------- SELECT CASE (MODE) CASE (1) CHR = 'WV (Windows95/NT, 640x480)' CASE (2) CHR = 'WS (Windows95/NT, 800x600)' CASE (3) CHR = 'WX (Windows95/NT, 1024x768)' CASE (4) CHR = 'WZ (Windows95/NT, 1280x1024)' CASE DEFAULT CHR = 'W9 (Windows95/NT, mode from environment)' END SELECT LCHR = LEN_TRIM(CHR) C CASE (2) C--- IFUNC = 2, Return physical min and max for plot device, and range C of color indices.--------------------------------------- IF (QFIRST(ACTIVE)) THEN MXX(ACTIVE) = MX(MODE) MXY(ACTIVE) = MY(MODE) MXC(ACTIVE) = 236 CALL GRW900(ACTIVE, MXX, MXY, MXC, QFIRST) END IF RBUF(1) = 0. RBUF(2) = MXX(ACTIVE) RBUF(3) = 0. RBUF(4) = MXY(ACTIVE) RBUF(5) = 0. RBUF(6) = MXC(ACTIVE) NBUF = 6 C CASE (3) C--- IFUNC = 3, Return device resolution. ------------------------------ C Divide the number of pixels on screen by a typical screen size in C inches. IF (QFIRST(ACTIVE)) THEN MXX(ACTIVE) = MX(MODE) MXY(ACTIVE) = MY(MODE) MXC(ACTIVE) = 236 CALL GRW900(ACTIVE, MXX, MXY, MXC, QFIRST) END IF RBUF(1) = FLOAT(MXX(ACTIVE)+1)/10. RBUF(2) = FLOAT(MXY(ACTIVE)+1)/7.5 RBUF(3) = 1.0 NBUF = 3 C CASE (4) C--- IFUNC = 4, Return misc device info. ------------------------------- C (This device is Interactive, Cursor, No dashed lines, No area fill, C No thick lines, Rectangle fill, Pixel primative, No ?, querY color C representation, No markers) CHR = 'ICNNNRPNYN' LCHR = 10 C CASE (5) C--- IFUNC = 5, Return default file name. ------------------------------ CHR = 'PGPlot Graphics' LCHR = LEN_TRIM(CHR) C CASE (6) C--- IFUNC = 6, Return default physical size of plot. ------------------ IF (QFIRST(ACTIVE)) THEN MXX(ACTIVE) = MX(MODE) MXY(ACTIVE) = MY(MODE) MXC(ACTIVE) = 236 CALL GRW900(ACTIVE, MXX, MXY, MXC, QFIRST) END IF RBUF(1) = 0. RBUF(2) = MXX(ACTIVE) RBUF(3) = 0. RBUF(4) = MXY(ACTIVE) NBUF = 4 C CASE (7) C--- IFUNC = 7, Return misc defaults. ---------------------------------- RBUF(1) = 1. NBUF = 1 C CASE (8) C--- IFUNC = 8, Select plot. ------------------------------------------- I = NINT(RBUF(2)) IF (I.GE.1 .AND. I.LE.MAXDEV .AND. STATE(I).GT.0) THEN IF (I .NE. ACTIVE) THEN ACTIVE = I I4STAT = SETACTIVEQQ(IUNIT(ACTIVE)) I4STAT = FOCUSQQ(IUNIT(ACTIVE)) DO I=0,235 RGB236(I) = RGB(I,ACTIVE) END DO I4STAT = REMAPALLPALETTE(RGB236) I2STAT = SETCOLOR(ICOLOR) END IF ELSE CALL GRWARN('invalid or unopened graphics window in W9DRIV') END IF C CASE (9) C--- IFUNC = 9, Open workstation. -------------------------------------- I = 0 DO WHILE (I.LE.MAXDEV .AND. STATE(I).NE.0) I = I + 1 END DO IF (I .GT. MAXDEV) THEN CALL GRWARN('maximum number of graphics windows exceeded') RBUF(1) = 0. RBUF(2) = 0. ELSE ACTIVE = I RBUF(1) = ACTIVE RBUF(2) = 1. C Initialize this window in requested mode, and open it MXX(ACTIVE) = MX(MODE) MXY(ACTIVE) = MY(MODE) MXC(ACTIVE) = 236 CALL GRGLUN(IUNIT(ACTIVE)) WRITE (WINTITLE, '(A,I2)') CHR(:LCHR)//', #', ACTIVE OPEN (IUNIT(ACTIVE), FILE='USER', TITLE=WINTITLE(:LCHR+5)) CALL GRW900(ACTIVE, MXX, MXY, MXC, QFIRST) DO I=0,235 RGB236(I) = RGB(I,ACTIVE) END DO I4STAT = REMAPALLPALETTE(RGB236) I2STAT = SETCOLOR(ICOLOR) STATE(ACTIVE) = 1 NPIC(ACTIVE) = 0 END IF NBUF = 2 C CASE (10) C--- IFUNC=10, Close workstation. -------------------------------------- IF (STATE(ACTIVE) .GT. 0) THEN print ('(A,I2)'), ' Type to close graphics '// & & 'window #',active read * CLOSE (IUNIT(ACTIVE)) STATE(ACTIVE) = 0 QFIRST(ACTIVE) = .TRUE. END IF C CASE (11) C--- IFUNC=11, Begin picture. ------------------------------------------ IF(NPIC(ACTIVE) .EQ. 0) THEN CALL CLEARSCREEN($GCLEARSCREEN) END IF STATE(ACTIVE) = 2 NPIC(ACTIVE) = NPIC(ACTIVE) + 1 I4STAT = SETACTIVEQQ(IUNIT(ACTIVE)) I4STAT = FOCUSQQ(IUNIT(ACTIVE)) C CASE (12) C--- IFUNC=12, Draw line. ---------------------------------------------- I2X0 = NINT(RBUF(1)) I2Y0 = MXY(ACTIVE) - NINT(RBUF(2)) CALL MOVETO(I2X0, I2Y0, XY) I2X1 = NINT(RBUF(3)) I2Y1 = MXY(ACTIVE) - NINT(RBUF(4)) I2STAT = LINETO(I2X1, I2Y1) C CASE (13) C--- IFUNC=13, Draw dot. ----------------------------------------------- I2X0 = NINT(RBUF(1)) I2Y0 = MXY(ACTIVE) - NINT(RBUF(2)) I4STAT = SETPIXEL(I2X0, I2Y0) C CASE (14) C--- IFUNC=14, End picture. -------------------------------------------- IF (STATE(ACTIVE) .GT. 0) STATE(ACTIVE) = 1 NPIC(ACTIVE) = 0 C CASE (15) C--- IFUNC=15, Select color index. ------------------------------------- ICOLOR = MIN(MXC(ACTIVE), MAX(0, NINT(RBUF(1)))) I2STAT = SETCOLOR(ICOLOR) C CASE (16) C--- IFUNC=16, Flush buffer. ------------------------------------------- C CASE (17) C--- IFUNC=17, Read cursor (mouse) AND keystroke ----------------------- I4X = NINT(RBUF(1)) I4Y = MXY(ACTIVE) - NINT(RBUF(2)) IF (NBUF .GE. 6) THEN C Support for multiple forms of cursor IXREF = NINT(RBUF(3)) IYREF = MXY(ACTIVE) - NINT(RBUF(4)) BAND = NINT(RBUF(5)) LPOS = RBUF(6) .GT. 0. ELSE C Simple crosshair cursor IXREF = I4X IYREF = I4Y BAND = 0 LPOS = .TRUE. END IF C C Set color index, for exclusive-ORing ICOLOR = SETCOLOR(CBITS(ACTIVE)) I4STAT = SETWRITEMODE($GXOR) C Initialize mouse routine by calling with fake arguments CALL GRW901(-BAND, MXX(ACTIVE), MXY(ACTIVE), IXREF, IYREF) C Initialize position of cursor by simulating mouse button click IF (LPOS) CALL GRW901(IUNIT(ACTIVE), MOUSE$MOVE, 0, I4X, I4Y) C Activate mouse callback routine EVENT = MOUSE$MOVE I4STAT = REGISTERMOUSEEVENT(IUNIT(ACTIVE), EVENT, GRW901) C Wait for a keystroke CHR(1:1) = GETCHARQQ() C C A key has been struck; turn off mouse, get position, restore color I4STAT = UNREGISTERMOUSEEVENT(IUNIT(ACTIVE), EVENT) CALL GRW901(0, 0, 0, I4X, I4Y) I4STAT = SETWRITEMODE($GPSET) I2STAT = SETCOLOR(ICOLOR) C Return results LCHR = 1 RBUF(1) = I4X RBUF(2) = MXY(ACTIVE) - I4Y NBUF = 2 C CASE (18) C--- IFUNC=18, Erase alpha screen. ------------------------------------- C CASE (19) C--- IFUNC=19, Set line style. ----------------------------------------- C Note: not likely to be called because IFUNC=4 returns "No dashed lines" I = MIN(5, MAX(0, NINT(RBUF(1)))) CALL SETLINESTYLE(DASHLINE(I)) C C--- IFUNC=20, Polygon fill. ------------------------------------------- C CASE (21) C--- IFUNC=21, Set color representation. ------------------------------- I = NINT(RBUF(1)) IF (I.GE.0 .AND. I.LE.MXC(ACTIVE)) THEN ICOLOR = I IRGB = NINT(RBUF(2)*CNORM) .OR. & & ISHFT(NINT(RBUF(3)*CNORM), 8) .OR. & & ISHFT(NINT(RBUF(4)*CNORM),16) RGB(I,ACTIVE) = IRGB CBITS(ACTIVE) = CBITS(ACTIVE) .OR. ICOLOR I4STAT = REMAPPALETTERGB(I, IRGB) END IF C C--- IFUNC=22, Set line width. ----------------------------------------- C C--- IFUNC=23, Escape. ------------------------------------------------- C CASE (24) C--- IFUNC=24, Rectangle fill. ----------------------------------------- I2X0 = NINT(RBUF(1)) I2Y0 = MXY(ACTIVE) - NINT(RBUF(2)) I2X1 = NINT(RBUF(3)) I2Y1 = MXY(ACTIVE) - NINT(RBUF(4)) I2STAT = RECTANGLE($GFILLINTERIOR, I2X0, I2Y0, I2X1, I2Y1) C C--- IFUNC=25, Set fill pattern. --------------------------------------- C CASE (26) C--- IFUNC=26, Line of pixels. ----------------------------------------- IY(1) = MXY(ACTIVE) - NINT(RBUF(2)) IF (IY(1).GE.0 .AND. IY(1).LE.MXY(ACTIVE)) THEN IX(1) = NINT(RBUF(1)) IBUF = 3 IF (IX(1) .LT. 0) THEN IBUF = 3 - IX(1) IX(1) = 0 END IF DO WHILE (IBUF.LE.NBUF .AND. I2X0.LE.MXX(ACTIVE)) IC(1) = MIN(MXC(ACTIVE), MAX(0, NINT(RBUF(IBUF)))) CALL SETPIXELS(1, IX, IY, IC) IBUF = IBUF + 1 IX(1) = IX(1) + 1 END DO END IF C C--- IFUNC=27, Scaling info -------------------------------------------- C C--- IFUNC=28, Draw marker --------------------------------------------- C CASE (29) C--- IFUNC=29, Query color representation.------------------------------ I = NINT(RBUF(1)) IRGB = RGB(I,ACTIVE) RBUF(2) = FLOAT(IAND(IRGB, #FF))/CNORM RBUF(3) = FLOAT(IAND(ISHFT(IRGB,-8), #FF))/CNORM RBUF(4) = FLOAT(IAND(ISHFT(IRGB,-16), #FF))/CNORM NBUF = 4 C CASE DEFAULT C--- Unimplemented Function WRITE (CMSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in Win95 device driver:'// & & CMSG) NBUF = -1 END SELECT RETURN END C********* SUBROUTINE GRW900(I, MXX, MXY, MXC, QFIRST) USE DFLIB C 1998-May-04 - change from MSFLIB to DFLIB C 1998-Jun-22 - don't set WC.title to 'PGPLOT' IMPLICIT NONE INTEGER I, MXX(*), MXY(*), MXC(*) LOGICAL QFIRST(*) C--- TYPE (WINDOWCONFIG) WC INTEGER TR$L LOGICAL STATUS CHARACTER TR$VID*128 C--- C Set default window configuration C Try to set to input values of MXX, MXY, default 800x600 IF (MXX(I).LE.1 .OR. MXY(I).LE.1) THEN MXX(I) = 800 MXY(I) = 600 MXC(I) = 256 CALL GRGENV('VIDEO', TR$VID, TR$L) IF (TR$L .GT. 0) THEN C There is a "PGPLOT_VIDEO" parameter in the Environment IF( TR$VID(1:1) .EQ. 'V') THEN C Set to VGA resolution MXX(I) = 640 MXY(I) = 480 ELSE IF (TR$VID(1:1) .EQ. 'X') THEN MXX(I) = 1024 MXY(I) = 768 ELSE IF (TR$VID(1:1) .EQ. 'Z') THEN MXX(I) = 1280 MXY(I) = 1024 END IF END IF END IF C WC.numxpixels = MXX(I) WC.numypixels = MXY(I) WC.numcolors = MXC(I) WC.numtextcols = -1 WC.numtextrows = -1 WC.fontsize = -1 STATUS = SETWINDOWCONFIG(WC) IF(.NOT.STATUS) STATUS = SETWINDOWCONFIG(WC) C MXX(I) = WC.numxpixels - 1 MXY(I) = WC.numypixels - 1 MXC(I) = WC.numcolors - 1 QFIRST(I) = .FALSE. RETURN END C********* RECURSIVE SUBROUTINE GRW901(IUNIT,EVENT,KEYSTATE,XMOUSE,YMOUSE) USE DFLIB IMPLICIT NONE INTEGER IUNIT, EVENT, KEYSTATE, XMOUSE, YMOUSE C C Callback routine for mouse events, specific to Windows95 C Note: cursor band modes implemented in software C C 1996-Apr-26 - P.A.Seeger C 1998-May-04 - change from MSFLIB to DFLIB C-- RECORD /xycoord/ XY INTEGER*2 BAND, LENGTH, IX0, IY0, IX1, IY1, IX2, IY2, IXR, IYR INTEGER*4 DUMMY LOGICAL INITIUS, FINIS DATA INITIUS /.TRUE./ SAVE INITIUS,BAND,LENGTH,IX0,IY0,IX1,IY1,IX2,IY2,IXR,IYR C C Disable mouse movement interrupts while in callback routine IF (IUNIT .GT. 0) DUMMY = UNREGISTERMOUSEEVENT(IUNIT, MOUSE$MOVE) C FINIS = IUNIT.EQ.0 .AND. EVENT.EQ.0 .AND. KEYSTATE.EQ.0 IF (IUNIT.LE.0 .AND. .NOT.FINIS) THEN INITIUS = .TRUE. C Get initialization parameters from callback calling sequence BAND = -IUNIT IXR = XMOUSE IYR = YMOUSE IX0 = IXR IY0 = IYR C Extract parameters for length of cursor lines IF (BAND .EQ. 0) THEN C Simple crosshair cursor LENGTH = MAX(EVENT, KEYSTATE)/80 + 3 ELSE LENGTH = 0 IX1 = 0 IX2 = 0 IY1 = 0 IY2 = 0 C Modes with full width horizontal line(s) IF (BAND.EQ.3 .OR. BAND.EQ.5 .OR. BAND.EQ.7) IX2 = EVENT C Modes with full height vertical line(s) IF (BAND.EQ.4 .OR. BAND.EQ.6 .OR. BAND.EQ.7) IY2 = KEYSTATE IF (BAND .EQ. 3) THEN C Draw fixed horizontal line at anchor CALL MOVETO(IX1, IYR, XY) DUMMY = LINETO(IX2, IYR ) ELSE IF (BAND .EQ. 4) THEN C Draw fixed vertical line at anchor CALL MOVETO(IXR, IY1, XY) DUMMY = LINETO(IXR, IY2 ) END IF END IF GO TO 700 END IF C IF (.NOT. INITIUS) THEN C This is NOT an initial call, so need to erase previous cursor C by rewriting it in complementary color mode IF (BAND .EQ. 1) THEN CALL MOVETO(IXR, IYR, XY) DUMMY = LINETO(IX0, IY0 ) ELSE IF (BAND .EQ. 2) THEN DUMMY = RECTANGLE($GBORDER, IXR, IYR, IX0, IY0) ELSE IF (IY2 .NE. IY1) THEN CALL MOVETO(IX0, IY1, XY) DUMMY = LINETO(IX0, IY2 ) END IF IF (IX2 .NE. IX1) THEN CALL MOVETO(IX1, IY0, XY) DUMMY = LINETO(IX2, IY0 ) END IF END IF END IF C IF (FINIS) THEN C Termination call, return latest mouse location XMOUSE = IX0 YMOUSE = IY0 IF (BAND .EQ. 3) THEN C Erase fixed horizontal line at anchor CALL MOVETO(IX1, IYR, XY) DUMMY = LINETO(IX2, IYR ) ELSE IF (BAND .EQ. 4) THEN C Erase fixed vertical line at anchor CALL MOVETO(IXR, IY1, XY) DUMMY = LINETO(IXR, IY2 ) END IF INITIUS = .TRUE. GO TO 700 END IF C C Save new cursor location IX0 = XMOUSE IY0 = YMOUSE IF (BAND .EQ. 0) THEN C Find ends of cursor line segments IX1 = IX0 - LENGTH IX2 = IX0 + LENGTH IY1 = IY0 - LENGTH IY2 = IY0 + LENGTH END IF C C Now draw line, box, or cursor in complementary color INITIUS = .FALSE. IF (BAND .EQ. 1) THEN C Line from anchor to cursor location CALL MOVETO(IXR, IYR, XY) DUMMY = LINETO(IX0, IY0 ) ELSE IF (BAND .EQ. 2) THEN C Box with vertices at anchor and cursor location DUMMY = RECTANGLE($GBORDER, IXR, IYR, IX0, IY0) ELSE IF (IY2 .NE. IY1) THEN C Draw a horizontal line (or segment) CALL MOVETO(IX0, IY1, XY) DUMMY = LINETO(IX0, IY2) END IF IF (IX2 .NE. IX1) THEN C Draw a vertical line (or segment) CALL MOVETO(IX1, IY0, XY) DUMMY = LINETO(IX2, IY0) END IF END IF C 700 CONTINUE IF (IUNIT.GT.0 .AND. .NOT.INITIUS) & & DUMMY = REGISTERMOUSEEVENT(IUNIT, MOUSE$MOVE, GRW901) RETURN END EN C Support for multiple forms of cursor IXREF = NINT(RBUF(3)) IYREF = MXY(ACTIVE) - NINT(RBUF(4)) BAND = NINT(RBUF(5)) LPOS = RBUF(6) .GT. 0. ELSE C Simple crosshair cursor IXREF = I4X IYREF = I4Y BAND = 0 LPOS = .TRUE. END IF C C Set color index, for exclusive-ORing ICOLOR = SETCOLOR(CBITS(ACTIVE)) pgplot/sys_win/grgfil.f010064400040640000322000000053200654622037300156550ustar00tjpcitmbr00000400000017C*GRGFIL -- find data file -- PC version C+ SUBROUTINE GRGFIL(TYPE, NAME) CHARACTER*(*) TYPE, NAME C C This routine encsapsulates the algorithm for finding the PGPLOT C run-time data files. C C 1. The binary font file: try the following in order: C file specified by PGPLOT_FONT C file "grfont.dat" in directory specified by PGPLOT_DIR C (with or without '\' appended) C file "grfont.dat" in directory C:\PGPLOT\ C C 2. The color-name database: try the following in order: C file specified by PGPLOT_RGB C file "rgb.txt" in directory specified by PGPLOT_DIR C (with or without '\' appended) C file "rgb.txt" in directory C:\PGPLOT\ C C Arguments: C TYPE (input) : either 'FONT' or 'RGB' to request the corresponding C file. C NAME (output) : receives the file name. C-- C 2-Dec-1994 - new routine [TJP]. C 30-Apr-1996 - PC version, default C:\PGPLOT\, '\' [PAS] C----------------------------------------------------------------------- CHARACTER*(*) DEFDIR, DEFFNT, DEFRGB PARAMETER (DEFDIR='C:\PGPLOT\') PARAMETER (DEFFNT='grfont.dat') PARAMETER (DEFRGB='rgb.txt') CHARACTER*255 FF CHARACTER*16 DEFLT INTEGER I, L, LD LOGICAL TEST, DEBUG C C Is debug output requested? C CALL GRGENV('DEBUG', FF, L) DEBUG = L.GT.0 C C Which file? C IF (TYPE.EQ.'FONT') THEN DEFLT = DEFFNT LD = LEN(DEFFNT) ELSE IF (TYPE.EQ.'RGB') THEN DEFLT = DEFRGB LD = LEN(DEFRGB) ELSE CALL GRWARN('Internal error in routine GRGFIL') END IF C C Try each possibility in turn. C DO 10 I=1,4 IF (I.EQ.1) THEN CALL GRGENV(TYPE, FF, L) ELSE IF (I.EQ.2) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:) = DEFLT L = L+LD END IF ELSE IF (I.EQ.3) THEN CALL GRGENV('DIR', FF, L) IF (L.GT.0) THEN FF(L+1:L+1) = '\' FF(L+2:) = DEFLT L = L+1+LD END IF ELSE IF (I.EQ.4) THEN FF = DEFDIR//DEFLT L = LEN(DEFDIR)+LD END IF IF (L.GT.0) THEN IF (DEBUG) THEN CALL GRWARN('Looking for '//FF(:L)) END IF INQUIRE (FILE=FF(:L), EXIST=TEST) IF (TEST) THEN NAME = FF(:L) RETURN ELSE IF (DEBUG) THEN CALL GRWARN('WARNING: file not found') END IF END IF 10 CONTINUE C C Failed to find the file. C NAME = DEFLT C----------------------------------------------------------------------- END pgplot/sys_win/pgbind.mak010064400040640000322000000011310654622037300161650ustar00tjpcitmbr00000400000017# Makefile for Microsoft Visual C++ V4.0 # platform: Windows-95 and Windows-NT (not tested) # purpose: creates CPGPLOT (C bindings) for PGPLOT graphics package # usage: copy this file (pgbind.mak), pgbind_prototypes and pgbind.c # to the directory where cpgplot.lib and cpgplot.h are # to be created # then type NMAKE /F PGBIND.MAK all: pgbind.exe cpgplot.lib clean pgbind.exe : pgbind.c cpgplot.lib:: .\pgbind ms -h -w pgbind_prototypes for %f in ( cpg*.c ) do cl /c %f lib /out:cpgplot.lib cpg*.obj clean:: del cpg*.obj del cpg*.c del pgbind.exe pgplot/sys_win/grsy00.f010064400040640000322000000062170654622037300155350ustar00tjpcitmbr00000400000017C*GRSY00 -- initialize font definition C+ SUBROUTINE GRSY00 C C This routine must be called once in order to initialize the tables C defining the symbol numbers to be used for ASCII characters in each C font, and to read the character digitization from a file. C C Arguments: none. C C Implicit input: C The file with name specified in environment variable PGPLOT_FONT C is read, if it is available. C This is a binary file containing two arrays INDEX and BUFFER. C The digitization of each symbol occupies a number of words in C the INTEGER*2 array BUFFER; the start of the digitization C for symbol number N is in BUFFER(INDEX(N)), where INDEX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series of vectors (polylines). * * The digital representation of all the symbols is stored in common * block /GRSYMB/. This is read from a disk file at run time. The * name of the disk file is specified in environment variable * PGPLOT_FONT. * * Modules: * * GRSY00 -- initialize font definition * GRSYDS -- decode character string into list of symbol numbers * GRSYMK -- convert marker number into symbol number * GRSYXD -- obtain the polyline representation of a given symbol * * PGPLOT calls these routines as follows: * * Routine Called by * * GRSY00 GROPEN * GRSYDS GRTEXT, GRLEN * GRSYMK GRMKER, * GRSYXD GRTEXT, GRLEN, GRMKER *********************************************************************** C-- C (2-Jan-1984) C 22-Jul-1984 - revise to use DATA statements [TJP]. C 5-Jan-1985 - make missing font file non-fatal [TJP]. C 9-Feb-1988 - change default file name to Unix name; overridden C by environment variable PGPLOT_FONT [TJP]. C 29-Nov-1990 - move font assignment to GRSYMK. C 7-Nov-1994 - look for font file in PGPLOT_DIR if PGPLOT_FONT is C undefined [TJP]. C----------------------------------------------------------------------- INTEGER*2 BUFFER(27000) INTEGER FNTFIL, IER, INDEX(3000), NC1, NC2, NC3 INTEGER L, GRTRIM COMMON /GRSYMB/ NC1, NC2, INDEX, BUFFER CHARACTER*128 FF C C Read the font file. If an I/O error occurs, it is ignored; the C effect will be that all symbols will be undefined (treated as C blank spaces). C CALL GRGFIL('FONT', FF) L = GRTRIM(FF) IF (L.LT.1) L = 1 CALL GRGLUN(FNTFIL) OPEN (UNIT=FNTFIL, FILE=FF(1:L), FORM='UNFORMATTED', 2 STATUS='OLD', IOSTAT=IER) IF (IER.EQ.0) READ (UNIT=FNTFIL, IOSTAT=IER) 1 NC1,NC2,NC3,INDEX,BUFFER IF (IER.EQ.0) CLOSE (UNIT=FNTFIL, IOSTAT=IER) CALL GRFLUN(FNTFIL) IF (IER.NE.0) THEN CALL GRWARN('Unable to read font file: '//FF(:L)) CALL GRWARN('Use environment variable PGPLOT_FONT to specify ' : //'the location of the PGPLOT grfont.dat file.') END IF RETURN END EX is an C integer array of 3000 elements. Not all symbols 1...3000 have C a representation; if INDEX(N) = 0, the symbol is undefined. C * PGPLOT uses the Hershey symbols for two `primitive' operations: * graph markers and text. The Hershey symbol set includes several * hundred different symbols in a digitized form that allows them to * be drawn with a series pgplot/sys_win/aaaread.me010064400040640000322000000302010723615307600161330ustar00tjpcitmbr00000400000017 PGPLOT 5.2.0 for Windows95/98/NT and Microsoft / Digital / Compaq Fortran P. A. Seeger, August 27, 1998 (document revised July 15, 2000) e-mail: PASeeger@aol.com (Based on C. T. Dum, May 1995) The following notes describe the porting of Tim Pearson's PGPLOT 5.2.0 to Microsoft Windows95/98 (or WindowsNT), using Microsoft Developer Studio and the corresponding Fortran compiler. The 32-bit Windows systems are easy to use, but most importantly remove the severe memory restrictions of DOS. The size of applications which can be linked with PGPLOT.LIB is limited only by total physical and virtual memory. The graphics libraries MSFLIB (Microsoft) or DFLIB (Digital/Compaq) also include many additional (system) functions known from C. Even for an old-fashioned command-line Fortran programer (like PAS), it is relatively easy to add features like dialog boxes and custom menus. Once PGPLOT.LIB is built, applications are most easily compiled using the Microsoft Developer Studio. The application type must be "QuickWin", or it must be compiled with command line option "/MW". Programs execute in a text window, with the graphical output in up to 8 separate child windows. Cursor functions (including rubber-band modes) are implemented by moving the mouse and typing a keyboard key. There are three versions of the Developer Studio. You MUST have the same version for Fortran and for C++ in order to mix languages. Although the Fortran code is the same, the user interface is slightly different. The versions are Developer Studio 4.0, Microsoft PowerStation Fortran 4.0 Developer Studio 5.0, Digital Visual Fortran 5.0 Developer Studio 6.0, Digital Visual Fortran 6.0 or Compaq Visual Fortran 6.1 NOTE: applications developed in these Fortrans will NOT execute under DOS or Windows 3.x (no, not even with WIN32s installed). The steps in building PGPLOT.LIB are the following: 1. Download PGPLOT 5.2.0 by your favorite method. I decompressed ver. 5.0.3 on VAX-VMS system, and ver. 5.1.beta from a Unix machine ("uncompress" followed by "tar -xcf"). But I have now acquired WinZip (Nico Mak Computing, Inc., www.winzip.com) which performs Gunzip and tar in the PC (very good program - I even sent them the $29 fee!). Just make the file name "PGPLOT52.TGZ" and open it in WinZip. 2. Create an appropriate subdirectory structure; e.g. x:\PGPLOT \SRC \SYS_WIN \DRIVERS \FONTS \EXAMPLES where x: is either C: or another hard disk in your system. Extract files from the corresponding subdirectories of the downloaded .TGZ file. Note: The copy of GRGFIL.F from the \SRC folder must be omitted in favor of the copy in \SYS_WIN to get an appropriate default directory. (Personal preference note: I also copy \APPLICAT\PLOT10\PLOT10.F into the \SRC subdirectory.) The files in \SYS_WIN should include AAAREAD.ME (this file) AAAREAD.ME2 (information for C programmers) GIDRIV.F (Fortran90 version of GIF driver, without "C" calls) GRDOS.F GREXEC.F GRGFIL.F (replace the version in \SRC) GRSY00.F (not system dependent) PGBIND.MAK (see AAAREAD.ME2 for discussion) W9DRIV.F (the driver itself, with attached subroutines) The file W9DRIV.F as included is appropriate for Digital or Compaq. To convert to Microsoft, replace the fourth line USE DFLIB with USE MSFLIB This same change must be made in subroutines GRW900 and GRW901. 3. If you did not use C: in step 2, create a directory C:\PGPLOT and copy RGB.TXT to it from x:\PGPLOT. You also need to compile and execute the program PGPACK from subdirectory x:\PGPLOT\FONTS to convert file GRFONT.TXT to binary file GRFONT.DAT. To run PGPACK in the Windows environment, put this statement before the READs: OPEN (5, FILE='x:\pgplot\fonts\grfont.txt') Likewise the OPEN statement for the output can be modified: OPEN (2, FILE='c:\pgplot\grfont.dat') The output file is different for Microsoft and Digital/Compaq. (The directory with these two files can be elsewhere if identified by environment variable PGPLOT_DIR, or the full [path]filenames can be given in environment variables PGPLOT_RGB and PGPLOT_FONT.) 4. In the Developer Studio, in the File/New menu, Create a new Project Workspace of Type "Static Library", Name PGPLOT, Location x:\MSDEV\PROJECTS\ (ver. 4) or x:\Program Files\DevStudio\MyProjects\ (ver. 5) or x:\Program Files\Microsoft Visual Studio\MyProjects\ (ver. 6). Use the Insert/"Files into Project..." (ver. 4) or Project/Add to Project/Files... (vers. 5/6) and the search box to associate the following files with the project: x:\PGPLOT\SRC\*.F x:\PGPLOT\SYS_WIN\*.F x:\PGPLOT\DRIVERS\LXDRIV.F,NUDRIV.F,PSDRIV.F (The dependent *.INC files will be included automatically.) 5. Build the project. For Digital/Compaq, the following compiler option is required for GIDRIV.F (because Digital changed the default for length of direct-access records from bytes to 4-byte words): /assume:byterecl This option is set as follows: Project/Settings/Fortran tab Settings For: All Configurations Source files: Gidriv.f Category: Fortran Data ver. 5, check: Use Bytes as Units for Unformatted Files ver. 6, Data Options check: Use Bytes as RECL= unit for Unformatted Files The remaining default compiler options are suitable; in particular, the Debug configuration is not optimized, but the Release configuration uses full optimization. (If the choice of "Release" is not apparent, use Build/Set Active Configuration...) From the Build menu, choose "Build PGPLOT.LIB". Expect 7 Warning messages with ver. 4, or 2 with vers. 5/6. When both Debug and Release have successfully completed, I like to copy the Release version of the library so that subsequent applications can find it more easily: ver. 4, from x:\MSDEV\PROJECTS\PGPLOT\RELEASE to x:\MSDEV\LIB ver. 5, from x:\Program Files\DevStudio\MyProjects\PGPLOT\RELEASE to x:\Program Files\DevStudio\DF\LIB ver. 6, from x:\Program Files\Microsoft Visual Studio\MyProjects\PGPLOT\RELEASE to x:\Program Files\Microsoft Visual Studio\DF98\LIB 6. Run the examples. In the same Project Workspace, use File/New and the Projects tab (or if using ver. 4, Insert/Project...) to create a "QuickWin Application", Name EXAMPLES. Then use Project/Dependencies (ver. 4, Build/Subprojects...) to specify that PGPLOT is a subproject of EXAMPLES. One at a time, use Project/Add to Project/Files... (ver. 4, Insert/Files into Project...) to select a file from x:\PGPLOT\EXAMPLES. (The previous file may be deleted from the FileView window when success- fully completed.) From the Build menu, choose "Execute EXAMPLES.EXE". The first page of the first test (PGDEMO1.F) should be a parabola. If there is no text on the plot, then you have not successfully created or located the file GRFONT.DAT (see step 3 above). If windows are created but neither graphics nor text appear, the problem may be that the display is set to a mode which doesn't use the SVGA color registers; decrease the color palette to 16M or fewer colors. After successfully testing the library, you may delete all of the PGPLOT folders from x:\MSDEV\PROJECTS (ver. 4) or from x:\Program Files\DevStudio\MyProjects\ (ver. 5) or from x:\Program Files\Microsoft Visual Studio\MyProjects\ (ver. 6). 7. Drivers for Windows95/NT, PostScript, GIF, LaTeX, and the Null driver are included by default. If you add additional drivers (which may require debugging to eliminate perceived syntax errors etc.) to the library, then the CASE structure in subroutine GREXEC.F must also be modified to reflect the changes; also, NDEV must reflect the total number of drivers. The default graphic window size for device type "/W9" is 800*600 with 236 colors (SVGA); 20 colors are reserved for system use. The default can be changed by setting an environment variable (either in AUTOEXEC.BAT, or from a command line before starting the application) as follows: SET PGPLOT_VIDEO=VGA (or V), 640 * 480 SVGA (or S), 800 * 600 XGA (or X), 1024 * 768 ZGA (or Z), 1280 * 1024 Modes may also be selected by using alternate device types "/WV", "/WS", "/WX", or "/WZ". Modes exceeding the capability of your Windows screen driver will be reduced to the maximum available. For an example of the 236-color modes, see PGDEMO4. For an example of different resolutions, try using "Menu/WV" for the first window and "Graphs/WX" for the second window in PGDEMO13. (Note the use of the device specification to name the window.) 8. The cursor is emulated by an interrupt driven mouse routine (see GRW901 in file W9DRIV.F). The cursor moves continuously whenever the window is selected, but the position is not returned to the calling program until a key has been struck, and the character is also returned. Control then returns to the "text" window for any additional input or processing. If you lose track, there is a status message at the bottom of the frame window which tells you which window is waiting for input (except, see Note in previous section). The color of the cursor may be dim against some backgrounds (especially green in the default palette), but you can usually see it at the tip of the mouse arrow while you move it around. You might try using PGBAND mode 7 for the cursor to improve visibility. See especially programs PGDEMO5 and PGDEMO6. 9. Plots can be clipped and copied to other applications, such as Word. Unfortunately, black is black and white is white, so printing uses a lot of ink and the white lines tend to disappear. One option is to exchange palette colors 0 and 1 in PGPLOT with CALL PGSCR(0, 1., 1., 1.) !black becomes white CALL PGSCR(1, 0., 0., 0.) !white becomes black before making the version to be printed; another is to cut and paste to a utility (I use Paint-Shop-Pro) in which you can adjust the color palette; and a third way is to specify either the "filename.ps/PS" or "filename.gif/GI" device and write a file. (Note: this might be a good use for a custom menu entry in your application.) Yet another option is to create a second device window and change the color palette only in that window. (See PGDEMO13 for an example of multiple simultaneous windows.) 10. Finally, this port has been thoroughly tested (starting with earlier versions of PGPLOT, and using the Microsoft compiler), but no responsibility for any damages is accepted (by either [PAS], [CTD], or even [TJP])! User input concerning "features" of the driver or this document is welcomed. *** Frequently Asked Questions *** A. "A window is created, but nothing appears in it." Most new graphics driver cards do not emulate color registers when they run in "True Color (32 bit)" mode. You will have to reset the Display Properties (Settings tab) to a smaller number of colors, such as "High Color (16 bit)." B. "Graphs appear, but no labels." Review step 3 above. The version of file GRFONT.DAT for your compiler must be in directory C:\PGPLOT\. C. "All of the demo programs work, except PGDEMO3 gives a Linker error." There is a bug in PGDEMO3 that is only picked up by these compilers. About 27 lines from the end of PGDEMO3.F, the statement CALL PGVSTD(0.05,0.95,0.05,0.95) must be replaced with CALL PGVSTD D. "I can't read the hardcopy files created with "/GI". Review step 5 above. Some applications (namely Paint-Shop-Pro) will read files written when the code is compiled without this option, but most will not. If you read the file in Paint-Shop-Pro and then save it, other applications will be able to read it. GRW901. 3. If you did not use C: in step 2, create a directory C:\PGPLOT and copy RGB.TXT to it from x:\PGPLOT. You also need to compile and execute the program PGPACK from subdirectory x:\PGPLOT\FONTS to convert file GRFONT.TXT to binary file GRFONT.DAT. To run PGPACK in the Windows environment, put this statement before the READs: OPEN (5, FILE='x:\pgplpgplot/sys_win/aaaread.me2010064400040640000322000000033150654622037300162210ustar00tjpcitmbr00000400000017---- file aaaread.me2 ----- This note explains how the C binding to PGPLOT (cpgplot) can be used under Windows. It applies to * C programs compiled with MS Visual C++ V4.0; * calling PGPLOT compiled with MS Powerstation Fortran V4.0; * under MS Windows-95 or Windows-NT. Other compilers may use different calling conventions and will require a different version of the C binding. You need the following files from PGPLOT v5.2 or later: pgplot/cpg/pgbind.c pgplot/cpg/pgbind_prototypes pgplot/sys_win/pgbind.mak (pgbind_prototypes is a list of the C function prototype lines extracted from the Fortran source code for PGPLOT.) ----------------------------------------------------------------------- Installation: To build the cpgplot binding library, you will need the following files: pgbind.c pgbind.mak pgbind_prototypes These files can be located anywhere convenient. To build the library, from a console (DOS) window type NMAKE /F PGBIND.MAK This will create cpgplot.lib and cpgplot.h The makefile compiles pgbind.c (no unusual compiler flags are needed) to produce the pgbind program. It then produces the C wrapper functions (one file per wrapper) and the cpgplot.h header file using: pgbind ms -w -h pgbind_prototypes The cpg*.c files are then compiled and gathered into a library. ------------------------------------------------------------------------- Usage: To use cpgplot in your programs, you should include cpgplot.h at the top of all C files that use cpgplot functions, and link your programs with both of cpgplot.lib and pgplot.lib. For further information about using the C binding, see file pgplot/cpg/cpgplot.doc or the Web page http://astro.caltech.edu/~tjp/pgplot/cbinding.html pgplot/sys_win/gidriv.f010064400040640000322000000536510723606656200157060ustar00tjpcitmbr00000400000017!C*GIDRIV -- PGPLOT GIF drivers !C+ SUBROUTINE GIDRIV (IFUNC, RBUF, NBUF, CHR, LCHR, MODE) IMPLICIT NONE INTEGER IFUNC, NBUF, LCHR, MODE REAL RBUF(*) CHARACTER*(*) CHR ! ! PGPLOT driver for Graphics Interchange Format (GIF) files. ! !*********************************************************************** ! CAUTION * ! * ! The GIF specification incorporates the Lempel-Zev-Welch (LZW) * ! compression technology which is the subject of a patent awarded to * ! Unisys. Use of this technology, and in particular creation of GIF * ! format files using this PGPLOT device driver, may require a license * ! from Unisys. * !*********************************************************************** ! ! Supported device: GIF87a file format ! ! Device type codes: /GIF or /VGIF ! ! Default device name: pgplot.gif. ! ! If you have more than one image to plot (i.e. use PGPAGE) with this ! device, subsequent pages will be named: pgplot2.gif, pgplot3.gif, ! etc, disrespective of the device name you specified. ! You can however bypass this by specifying a device name including a ! number sign (#), which will henceforth be replaced by the pagenumber. ! Example: page#.gif will produce files page1.gif, page2.gif, ..., ! page234.gif, etc. ! ! Default view surface dimensions are: ! - GIF : 1200 x 900 pixels (translates to 8.0 x 6.0 inch). ! - VGIF : 900 x 1200 pixels (translates to 6.0 x 8.0 inch). ! with an assumed scale of 150 pixels/inch. ! Default width and height can be overridden by specifying environment ! variables ! PGPLOT_GIF_WIDTH (default 1200) ! PGPLOT_GIF_HEIGHT (default 900) ! ! Color capability: ! Indices 0 to 255 are supported. Each of these indices can be assigned ! one color. Default colors for indices 0 to 15 are implemented. ! ! Obtaining hardcopy: Use a GIF viewer or converter. != ! 1-Aug-1994 - Created by Remko Scharroo ! 9-Aug-1994 - New scheme for line plotting ! 16-Aug-1994 - Provide multi-image plotting. ! 8-Sep-1994 - Add opcode 29 [TJP]. ! 5-Nov-1994 - Adjust size of bitmap if necessary [TJP]. ! 18-Jan-1995 - Attempt to prevent integer overflow on systems where ! BYTE is signed [TJP]. ! 28-Dec-1995 - prevent concurrent access [TJP]. ! 10-Jul-1996 - Fortran (F90) version; make PIXMAP and WORK allocatable ! arrays; remove all pass-by-value; test ALLOCATED(PIXMAP); ! direct-access binary file output; higher resolution [PAS] ! 24-Apr-1998 - CASE structure instead of computed GOTO; "!" comments [PAS] ! 28-Aug-1998 - FORM='BINARY' in OPEN statements (Digital Visual Fortran 5.0) ! *** Note: Not standard F90; remove if troublesome. [BRupp] ! 26-Dec-2000 - treat signed bytes differently (Digital Fortran 6.0) [PAS] !----------------------------------------------------------------------- CHARACTER*(*) LTYPE, PTYPE, DEFNAM INTEGER DWD, DHT, BX, BY PARAMETER (LTYPE= & &'GIF (Graphics Interchange Format file, landscape orientation)',& & PTYPE= & &'VGIF (Graphics Interchange Format file, portrait orientation)') PARAMETER (DEFNAM='pgplot.gif') PARAMETER (DWD=1200, DHT=900) REAL XRES, YRES PARAMETER (XRES=150., YRES=XRES) ! INTEGER UNIT, IC, NPICT, MAXIDX, STATE INTEGER CTABLE(3,0:255), CDEFLT(3,0:15) INTEGER IER, I, L, IOS, IX0, IY0, IX1, IY1 INTEGER GRTRIM CHARACTER*80 MSG, INSTR, FILENM ! ! Note: for 64-bit operating systems, change the following ! declaration to INTEGER*8: ! INTEGER(1),ALLOCATABLE :: PIXMAP(:,:) INTEGER(2),ALLOCATABLE :: WORK(:,:) ! SAVE UNIT, IC, CTABLE, NPICT, MAXIDX, BX, BY, PIXMAP, FILENM SAVE CDEFLT, STATE DATA CDEFLT /000,000,000, 255,255,255, 255,000,000, 000,255,000, & & 000,000,255, 000,255,255, 255,000,255, 255,255,000, & & 255,128,000, 128,255,000, 000,255,128, 000,128,255, & & 128,000,255, 255,000,128, 085,085,085, 170,170,170/ DATA STATE /0/ !----------------------------------------------------------------------- ! SELECT CASE(IFUNC) ! !--- IFUNC = 1, Return device name ------------------------------------- CASE (1) SELECT CASE(MODE) CASE (1) CHR = LTYPE LCHR = LEN(LTYPE) CASE (2) CHR = PTYPE LCHR = LEN(PTYPE) CASE DEFAULT CALL GRWARN('Requested MODE not implemented in GIF driver') END SELECT ! !--- IFUNC = 2, Return physical min and max for plot device, and range ! of color indices --------------------------------------- ! (Maximum size is set by GIF format to 2**16 pixels) CASE (2) RBUF(1) = 0 RBUF(2) = 65536 RBUF(3) = 0 RBUF(4) = 65536 RBUF(5) = 0 RBUF(6) = 255 NBUF = 6 ! !--- IFUNC = 3, Return device resolution ------------------------------- CASE (3) RBUF(1) = XRES RBUF(2) = YRES RBUF(3) = 1 NBUF = 3 ! !--- IFUNC = 4, Return misc device info -------------------------------- ! (This device is Hardcopy, supports rectangle fill, pixel ! primitives, and query color rep.) CASE (4) CHR = 'HNNNNRPNYN' LCHR = 10 ! !--- IFUNC = 5, Return default file name ------------------------------- CASE (5) CHR = DEFNAM LCHR = LEN(DEFNAM) ! !--- IFUNC = 6, Return default physical size of plot ------------------- CASE (6) RBUF(1) = 0 RBUF(2) = BX-1 RBUF(3) = 0 RBUF(4) = BY-1 NBUF = 4 ! !--- IFUNC = 7, Return misc defaults ----------------------------------- CASE (7) RBUF(1) = 1 NBUF=1 ! !--- IFUNC = 8, Select plot -------------------------------------------- CASE (8) ! !--- IFUNC = 9, Open workstation --------------------------------------- CASE (9) ! -- check for concurrent access IF (STATE.EQ.1) THEN CALL GRWARN('a PGPLOT GIF file is already open') RBUF(1) = 0 RBUF(2) = 0 RETURN END IF ! -- dimensions of plot buffer IF (MODE.EQ.1) THEN ! -- Landscape BX = DWD BY = DHT CALL GRGENV('GIF_WIDTH', INSTR, L) IF (L.GT.0) READ(INSTR(:L),'(BN,I10)',IOSTAT=IOS) BX CALL GRGENV('GIF_HEIGHT', INSTR, L) IF (L.GT.0) READ(INSTR(:L),'(BN,I10)',IOSTAT=IOS) BY ELSE ! -- Portrait BX = DHT BY = DWD CALL GRGENV('GIF_WIDTH', INSTR, L) IF (L.GT.0) READ(INSTR(:L),'(BN,I10)',IOSTAT=IOS) BY CALL GRGENV('GIF_HEIGHT', INSTR, L) IF (L.GT.0) READ(INSTR(:L),'(BN,I10)',IOSTAT=IOS) BX END IF NPICT=1 MAXIDX=0 ! -- Initialize color table DO I=0,15 CTABLE(1,I) = CDEFLT(1,I) CTABLE(2,I) = CDEFLT(2,I) CTABLE(3,I) = CDEFLT(3,I) END DO DO I=16,255 CTABLE(1,I) = 128 CTABLE(2,I) = 128 CTABLE(3,I) = 128 END DO ! FILENM = CHR(:LCHR) CALL GRGI10 (FILENM, NPICT, CHR) LCHR = GRTRIM(CHR) CALL GRGLUN(UNIT) NBUF = 2 RBUF(1) = UNIT OPEN (UNIT,FILE=CHR(1:LCHR),STATUS='UNKNOWN',ACCESS='DIRECT', & & RECL=255, FORM='BINARY', IOSTAT=IER) IF (IER.NE.0) THEN MSG = 'Cannot open output file for GIF plot: '//CHR(:LCHR) CALL GRWARN(MSG) RBUF(2) = 0 STATE = 0 CALL GRFLUN(UNIT) ELSE RBUF(2) = 1 STATE = 1 END IF ! !--- IFUNC=10, Close workstation --------------------------------------- CASE (10) STATE = 0 ! !--- IFUNC=11, Begin picture ------------------------------------------- CASE (11) BX = NINT(RBUF(1))+1 BY = NINT(RBUF(2))+1 ALLOCATE (PIXMAP(BX,BY), STAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Failed to allocate plot buffer.') BX = 0 BY = 0 ELSE ! -- initialize to zero (background color) CALL GRGI03(1, 1, BX, BY, 0, BX, BY, PIXMAP) IF (NPICT.GT.1) THEN CALL GRGI10 (FILENM, NPICT, MSG) CALL GRGLUN(UNIT) OPEN (UNIT, FILE=MSG, STATUS='UNKNOWN', ACCESS='DIRECT', & & RECL=255, FORM='BINARY', IOSTAT=IER) IF (IER.NE.0) & & CALL GRWARN('Cannot open output file for GIF plot') END IF END IF ! !--- IFUNC=12, Draw line ----------------------------------------------- CASE (12) IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY0=BY-NINT(RBUF(2)) IY1=BY-NINT(RBUF(4)) IF (ALLOCATED(PIXMAP)) & & CALL GRGI01(IX0, IY0, IX1, IY1, IC, BX, BY, PIXMAP) ! !--- IFUNC=13, Draw dot ------------------------------------------------ CASE (13) IX0=NINT(RBUF(1))+1 IY0=BY-NINT(RBUF(2)) IF (ALLOCATED(PIXMAP)) & & CALL GRGI01(IX0, IY0, IX0, IY0, IC, BX, BY, PIXMAP) ! !--- IFUNC=14, End picture --------------------------------------------- CASE (14) IF (UNIT.GE.0) THEN ALLOCATE (WORK(4098,256), STAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Failed to allocate work array.') ELSE CALL GRGI06(UNIT, BX, BY, CTABLE, PIXMAP, MAXIDX, WORK) END IF CLOSE (UNIT) CALL GRFLUN(UNIT) DEALLOCATE (WORK, STAT=IER) END IF NPICT = NPICT+1 DEALLOCATE (PIXMAP, STAT=IER) IF (IER.NE.0) THEN CALL GRWARN('Failed to deallocate plot buffer.') END IF ! !--- IFUNC=15, Select color index -------------------------------------- CASE (15) IC = RBUF(1) MAXIDX = MAX(MAXIDX, IC) ! !--- IFUNC=16, Flush buffer. ------------------------------------------- ! (Not used.) CASE (16) ! !--- IFUNC=18, Erase alpha screen. ------------------------------------- ! (Not implemented: no alpha screen) CASE (18) ! !--- IFUNC=21, Set color representation. ------------------------------- CASE (21) I = RBUF(1) CTABLE(1, I) = NINT(RBUF(2)*255) CTABLE(2, I) = NINT(RBUF(3)*255) CTABLE(3, I) = NINT(RBUF(4)*255) ! !--- IFUNC=23, Escape -------------------------------------------------- ! (Not implemented: ignored) CASE (23) ! !--- IFUNC=24, Rectangle fill ------------------------------------------ CASE (24) IX0=NINT(RBUF(1))+1 IX1=NINT(RBUF(3))+1 IY1=BY-NINT(RBUF(2)) IY0=BY-NINT(RBUF(4)) IF (ALLOCATED(PIXMAP)) & & CALL GRGI03(IX0, IY0, IX1, IY1, IC, BX, BY, PIXMAP) ! !--- IFUNC=25, Not implemented ----------------------------------------- CASE (25) ! !--- IFUNC=26, Line of pixels ------------------------------------------ CASE (26) CALL GRGI04(NBUF, RBUF, BX, BY, PIXMAP, MAXIDX) ! !--- IFUNC=27, Not implemented ----------------------------------------- CASE (27) ! !--- IFUNC=28, Not implemented ----------------------------------------- CASE (28) ! !--- IFUNC=29, Query color representation. ----------------------------- CASE (29) I = RBUF(1) RBUF(2) = CTABLE(1,I)/255.0 RBUF(3) = CTABLE(2,I)/255.0 RBUF(4) = CTABLE(3,I)/255.0 NBUF = 4 ! !--- Unimplemented Function CASE DEFAULT WRITE (MSG, '(I10)') IFUNC CALL GRWARN('Unimplemented function in GIF device driver:'// & & MSG) NBUF = -1 END SELECT RETURN !----------------------------------------------------------------------- END ! !*GRGI01 -- PGPLOT GIF driver, draw line !+ SUBROUTINE GRGI01 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY INTEGER(1) :: PIXMAP(BX,BY) ! ! Draw a straight-line segment from absolute pixel coordinates ! (IX0, IY0) to (IX1, IY1). ! ! Arguments: ! ICOL (input): Color index ! PIXMAP (input/output): The image data buffer. !----------------------------------------------------------------------- INTEGER IX, IY, IS REAL D INTEGER (1) :: VAL ! IF (ICOL.GT.127) THEN VAL = ICOL - 256 ELSE VAL = ICOL END IF IF (IX0.EQ.IX1 .AND. IY0.EQ.IY1) THEN PIXMAP(IX0,IY0) = VAL ELSE IF (ABS(IY1-IY0) .GT. ABS(IX1-IX0)) THEN D = FLOAT(IX1-IX0) / FLOAT(IY1-IY0) IS = 1 IF (IY1 .LT. IY0) IS = -1 DO IY=IY0,IY1,IS IX = NINT(IX0 + (IY-IY0)*D) PIXMAP(IX,IY) = VAL END DO ELSE D = FLOAT(IY1-IY0) / FLOAT(IX1-IX0) IS = 1 IF (IX1 .LT. IX0) IS = -1 DO IX=IX0,IX1,IS IY = NINT(IY0 + (IX-IX0)*D) PIXMAP(IX,IY) = VAL END DO END IF END ! !*GRGI03 -- PGPLOT GIF driver, fill rectangle !+ SUBROUTINE GRGI03 (IX0, IY0, IX1, IY1, ICOL, BX, BY, PIXMAP) INTEGER IX0, IY0, IX1, IY1 INTEGER ICOL, BX, BY INTEGER(1) :: PIXMAP(BX,BY) ! ! Arguments: ! IX0, IY0 (input): Lower left corner. ! IX1, IY1 (input): Upper right corner. ! ICOL (input): Color value. ! BX, BY (input): dimensions of PIXMAP. ! PIXMAP (input/output): The image data buffer. !----------------------------------------------------------------------- INTEGER IX, IY INTEGER(1) :: VAL ! IF (ICOL.GT.127) THEN VAL = ICOL - 256 ELSE VAL = ICOL END IF DO IY=IY0,IY1 DO IX=IX0,IX1 PIXMAP(IX,IY) = VAL END DO END DO RETURN END ! !*GRGI04 -- PGPLOT GIF driver, fill image line !+ SUBROUTINE GRGI04(NBUF,RBUF,BX,BY,PIXMAP,MAXIDX) INTEGER I,J,NBUF,BX,BY,N,IC,MAXIDX REAL RBUF(NBUF) INTEGER(1) :: PIXMAP(BX,BY) !- I = NINT(RBUF(1)) + 1 J = BY-NINT(RBUF(2)) DO N=3,NBUF IC = RBUF(N) MAXIDX = MAX(MAXIDX, IC) IF (IC .GT. 127) IC = IC - 256 PIXMAP(I+N-3,J) = IC END DO RETURN END ! !*GRGI06 -- PGPLOT GIF driver, write GIF image !+ SUBROUTINE GRGI06 (UNIT, BX, BY, CTABLE, PIXMAP, MAXIDX, CODE) INTEGER UNIT, BX, BY, MAXIDX INTEGER CTABLE(3,0:255) INTEGER(1) :: PIXMAP(BX*BY) INTEGER*2 CODE(0:4097,0:255) ! ! Write GIF image to UNIT. ! ! Arguments: ! UNIT (input): Output unit ! BX,BY (input): `Screen' size ! CTABLE (input): Color map ! PIXMAP (input): Image data ! MAXIDX (input): maximum color index used. !-- ! 16-Nov-94: fixed bug (BYTE is signed) ! 09-Jul-96: revised to use Fortran90 constructs and I/O [PAS] ! 26-Dec-00: treat signed bytes differently for Fortran v.6 [PAS] !----------------------------------------------------------------------- CHARACTER GIF1*6 INTEGER*4 BWIDTH, BSHIFT, BREST, BOUT, BREC INTEGER PIXEL, I, J, K, M, CLEAR, EOI, TABLE, IN, TOTAL, PRE, EXT INTEGER OLDPRE, BITS INTEGER (1) :: BLKOUT(0:266) COMMON /GRGICO/ BWIDTH, BSHIFT, BREST, BOUT, BREC, BLKOUT ! BITS = 1 DO WHILE (2**BITS .LE. MAXIDX) BITS = BITS + 1 END DO PIXEL = MAX(BITS, 2) CLEAR = 2**PIXEL EOI = CLEAR + 1 ! ! Write Header. ! ! Write Logical Screen Descriptor (screen width, screen height, ! color data, background color index [0], pixel aspect ratio [0]). GIF1 = 'GIF87a' DO I=1,6 BLKOUT(I-1) = ICHAR(GIF1(I:I)) END DO CALL GRGI09(BX, BLKOUT(6)) CALL GRGI09(BY, BLKOUT(8)) I = ISHFT(BITS-1, 4) BLKOUT(10) = IOR(IOR(128, I), BITS-1) BLKOUT(11) = 0 BLKOUT(12) = 0 BOUT = 12 BREC = 1 ! ! Write Global Color Table. DO J=0,2**BITS-1 BLKOUT(BOUT+1) = CTABLE(1,J) BLKOUT(BOUT+2) = CTABLE(2,J) BLKOUT(BOUT+3) = CTABLE(3,J) BOUT = BOUT + 3 IF (BOUT .GE. 254) THEN WRITE (UNIT,REC=BREC) (BLKOUT(I),I=0,254) BOUT = BOUT - 255 DO I=0,BOUT BLKOUT(I) = BLKOUT(I+255) END DO BREC = BREC + 1 END IF END DO ! ! Write Image Descriptor. BLKOUT(BOUT+1) = ICHAR(',') BLKOUT(BOUT+2) = 0 BLKOUT(BOUT+3) = 0 BLKOUT(BOUT+4) = 0 BLKOUT(BOUT+5) = 0 CALL GRGI09(BX, BLKOUT(BOUT+6)) CALL GRGI09(BY, BLKOUT(BOUT+8)) BLKOUT(BOUT+10) = 0 BLKOUT(BOUT+11) = PIXEL BOUT = BOUT + 11 IF (BOUT .EQ. 253) THEN ! This is a nasty surprise - make a dummy 1-byte sub-block BLKOUT(254) = 1 BLKOUT(255) = CLEAR BOUT = 255 END IF ! Check if record already longer than 255 bytes IF (BOUT .GE. 254) THEN WRITE (UNIT,REC=BREC) (BLKOUT(I),I=0,254) BOUT = BOUT - 255 DO I=0,BOUT BLKOUT(I) = BLKOUT(I+255) END DO BREC = BREC + 1 END IF ! ! Write Table Based Image Data, in sub-blocks of up to 255 bytes. ! How many bytes left for a sub-block in this direct-access record? BOUT = BOUT + 1 BLKOUT(BOUT) = 254 - BOUT ! ! LZW-compression; initialize counters ! Start packing variable-size codes into 8-bit bytes. ! BREST = 0 BSHIFT = 0 ! `Read' first character. IN = 1 TOTAL = BX * BY PRE = PIXMAP(IN) IF (PRE .LT. 0) PRE = PRE + 256 ! TABLE = 4095 BWIDTH = PIXEL + 1 ! DO WHILE (IN .LT. TOTAL) IF (TABLE .GE. 4095) THEN ! Start new data stream; if n=PIXEL, then ! 2**n-1 (n+1)-bit codes ! 2*2**n (n+2)-bit codes ! 4*2**n (n+3)-bit codes ! . . . ! 1024 11-bit codes ! 2048 12-bit codes (incl. one clear code) ! ! push a clear code first CALL GRGI07(UNIT, CLEAR) DO M=0,255 DO K=0,4095 CODE(K,M) = 0 END DO END DO ! Initialize last used table entry and code width in bits TABLE = EOI BWIDTH = PIXEL + 1 END IF ! ! `Read' next character; check if combination prefix/extension occurred earlier IN = IN + 1 EXT = PIXMAP(IN) IF (EXT .LT. 0) EXT = EXT + 256 OLDPRE = PRE PRE = CODE(PRE, EXT) ! IF (PRE .EQ. 0) THEN ! If no earlier occurrence add combination to table CALL GRGI07(UNIT, OLDPRE) TABLE = TABLE + 1 CODE(OLDPRE,EXT) = TABLE PRE = EXT ! May need to increase width of code entry by one bit IF (ISHFT(TABLE,-BWIDTH) .NE. 0) BWIDTH = BWIDTH + 1 END IF END DO ! ! Last character ! CALL GRGI07(UNIT, PRE) CALL GRGI07(UNIT, EOI) IF (BSHIFT .GT. 0) CALL GRGI08(UNIT, BREST) IF (BOUT .GT. 0) THEN BLKOUT(0) = BOUT BOUT = BOUT + 1 END IF BLKOUT(BOUT) = 0 IF (BOUT .EQ. 254) THEN WRITE (UNIT, REC=BREC) (BLKOUT(I),I=0,254) BOUT = -1 BREC = BREC + 1 END IF ! ! Write GIF Trailer. ! BLKOUT(BOUT+1) = ICHAR(';') DO I=BOUT+2,254 ! Zero fill the final direct-access record BLKOUT(I) = 0 END DO WRITE (UNIT,REC=BREC) (BLKOUT(I),I=0,254) RETURN END ! !*GRGI07 -- Compress GIF output codes into 8-bit bytes ! SUBROUTINE GRGI07(UNIT, INCODE) INTEGER UNIT, INCODE INTEGER*4 BWIDTH, BSHIFT, BREST, BOUT, BREC INTEGER(1) :: BLKOUT(0:266) COMMON /GRGICO/ BWIDTH, BSHIFT, BREST, BOUT, BREC, BLKOUT ! BREST = IOR(BREST, ISHFT(INCODE, BSHIFT)) BSHIFT = BSHIFT + BWIDTH ! DO WHILE (BSHIFT .GE. 8) ! Send low byte to buffer, and delete it CALL GRGI08(UNIT, BREST) BREST = ISHFT(BREST, -8) BSHIFT = BSHIFT - 8 END DO ! RETURN END ! !*GRGI08 -- Accumulate bytes and write GIF output sub-block ! SUBROUTINE GRGI08(UNIT, INCODE) INTEGER UNIT, INCODE, I INTEGER*4 BWIDTH, BSHIFT, BREST, BOUT, BREC INTEGER(1) :: BLKOUT(0:266) COMMON /GRGICO/ BWIDTH, BSHIFT, BREST, BOUT, BREC, BLKOUT ! BOUT = BOUT + 1 BLKOUT(BOUT) = IAND(INCODE, 255) IF (BOUT .GE. 254) THEN WRITE (UNIT,REC=BREC) (BLKOUT(I),I=0,254) BOUT = 0 BLKOUT(0) = 254 BREC = BREC + 1 END IF RETURN END ! !*GRGI09 -- Encode integer into 2 bytes ! SUBROUTINE GRGI09(IN, IOUT) INTEGER IN INTEGER(1) :: IOUT(2) ! IOUT(1) = IAND(IN, 255) IOUT(2) = ISHFT(IN, -8) RETURN END ! !*GRGI10 -- Replace # in filename by picture number ! SUBROUTINE GRGI10 (NAME1, NP, NAME2) CHARACTER*(*) NAME1 CHARACTER*(*) NAME2 CHARACTER*80 TMP INTEGER GRTRIM INTEGER NP, IDX, L, LN ! LN = GRTRIM(NAME1) IDX = INDEX(NAME1,'#') IF (IDX .GT. 0) THEN ! -- if the supplied name contains a #-character, replace ! it with the page number CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE IF (NP .EQ. 1) THEN ! -- if this is the first page, use the supplied name NAME2 = NAME1 RETURN ELSE IF (LN+2 .LE. LEN(NAME1)) THEN ! -- append an underscore and the page number to the supplied ! name NAME1(LN+1:LN+2) = '_#' CALL GRFAO(NAME1, L, TMP, NP, 0, 0, 0) ELSE ! -- last resort: invent a new name CALL GRFAO('pgplot#.gif', L, TMP, NP, 0, 0, 0) END IF CALL GRWARN ('Writing new GIF image as: '//TMP(:L)) NAME2 = TMP(:L) RETURN END n GIF device driver:'// & & MSG) NBUF = -1 END SELEpgplot/sys_win/pgpack.f010064400040640000322000000063670665347415300156720ustar00tjpcitmbr00000400000017 PROGRAM PACK C----------------------------------------------------------------------- C Convert unpacked (ASCII) representation of GRFONT into packed C (binary) representation used by PGPLOT. C C This version ignores characters in the input file with Hershey C numbers 1000-1999 ("indexical" fonts) and 3000-3999 ("triplex" C and "gothic" fonts). C C The binary file contains one record, and is a direct copy of the C internal data structure used in PGPLOT. The format of the internal C data structure (and the binary file) are private to PGPLOT: i.e., C they may be changed in a future release. C C NC1 Integer*4 Smallest Hershey number defined in file (1) C NC2 Integer*4 Largest Hershey number defined in file (3000) C NC3 Integer*4 Number of words of buffer space used C INDEX Integer*4 array (dimension 3000) C Element NC of INDEX contains either 0 if C NC is not a defined Hershey character, or the C index in array BUFFER at which the digitization C of character number NC begins C BUFFER Integer*2 array (dimension 27000) C Coordinate pairs defining each character are C packed two to a word in this array. C C Note: the array sizes are fixed by dimension statements in PGPLOT. C New characters cannot be added if they would increase the size of C the arrays. Array INDEX is not very efficiently used as only about C 1000 of the possible 3000 characters are defined. C----------------------------------------------------------------------- INTEGER MAXCHR, MAXBUF PARAMETER (MAXCHR=3000) PARAMETER (MAXBUF=27000) C INTEGER INDEX(MAXCHR) INTEGER*2 BUFFER(MAXBUF) INTEGER I, LENGTH, LOC, NC, NC1, NC2, NCHAR, XYGRID(400) C----------------------------------------------------------------------- 1000 FORMAT (7(2X,2I4)) 2000 FORMAT (' Characters defined: ', I5/ 1 ' Array cells used: ', I5) 3000 FORMAT (' ++ERROR++ Buffer is too small: ',I7) C----------------------------------------------------------------------- C C Initialize index. C DO 1 I=1,MAXCHR INDEX(I) = 0 1 CONTINUE LOC = 0 NCHAR = 0 C C Open input file. C OPEN (UNIT=1, STATUS='OLD', FILE='grfont.txt') C C Read input file. C 10 CONTINUE C -- read next character READ (1,1000,END=20) NC,LENGTH,(XYGRID(I),I=1,5) READ (1,1000) (XYGRID(I),I=6,LENGTH) C -- skip if Hershey number is outside required range IF (NC.LT.1 .OR. (NC.GT.999.AND.NC.LT.2000) .OR. 1 NC.GT.2999) GOTO 10 C -- store in index and buffer NCHAR = NCHAR+1 LOC = LOC+1 IF (LOC.GT.MAXBUF) GOTO 500 INDEX(NC) = LOC BUFFER(LOC) = XYGRID(1) DO 15 I=2,LENGTH,2 LOC = LOC + 1 IF (LOC.GT.MAXBUF) GOTO 500 BUFFER(LOC) = 128*(XYGRID(I)+64) + XYGRID(I+1) + 64 15 CONTINUE GOTO 10 20 CONTINUE C C Write output file. C OPEN (UNIT=2, STATUS='NEW', FORM='UNFORMATTED', FILE='grfont.dat') NC1 = 1 NC2 = 3000 WRITE (2) NC1,NC2,LOC,INDEX,BUFFER CLOSE (UNIT=2) C C Write summary. C WRITE (6,2000) NCHAR, LOC STOP C C Error exit. C 500 WRITE (6,3000) MAXBUF C----------------------------------------------------------------------- END pgplot/install-unix.txt010064400040640000322000000336010635127253500157350ustar00tjpcitmbr00000400000017PGPLOT Installation Instructions: UNIX systems Version 5.2.0 Note: The following instructions refer to two directories, the distribution (source) directory which will contain the PGPLOT source code directory tree, and the target directory in which the machine-specific libraries, data files, and demonstration programs will be created. It is recommended that you create new, empty directories for these. They should not be the same directory. In the examples below, these directories are named /usr/local/src/pgplot (distribution directory) /usr/local/pgplot (target directory) but you can use any convenient names. Unusual (root) privileges are not required to install PGPLOT, assuming you have write access to the directories. A single distribution directory can be used to install versions of PGPLOT for different architectures in different target directories. 1. Copy the distribution file Copy the distribution file by anonymous ftp from Caltech. Use anonymous ftp (user: anonymous, password: your id username@machine) to node astro.caltech.edu (131.215.240.1). The distribution file is a UNIX tar file compressed with gzip. Issue the following ftp commands to retrieve the file: cd pub/pgplot binary get pgplot5.2.tar.gz The text files in this directory are also included in the tar file. The distribution file can also be fetched from URL ftp://astro.caltech.edu/pub/pgplot/pgplot5.2.tar.gz. 2. Decompress the files Use gunzip and tar to decompress the archive and extract its contents. This will create directory pgplot (and subdirectories) in the current directory. Make sure that your current directory is where you want to create the ``PGPLOT distribution'' directory tree. cd /usr/local/src gunzip -c pgplot5.2.tar.gz | tar xvof - This example will create /usr/local/src/pgplot and subdirectories. 3. Create the target directory Create a writeable directory in which the PGPLOT library and associated files will be created. One such directory is needed for each different operating system and compiler combination (``target system'') that you wish to support, e.g., mkdir /usr/local/pgplot Do not try to create the PGPLOT library in the distribution directory. 4. Select device drivers Configure PGPLOT by selecting device drivers from the available list. First copy the file drivers.list from the distribution directory to the target directory, and then use a text editor to select device drivers. This file contains one line for each available device driver: delete the exclamation mark (!) at the beginning of the line to include the driver, or ensure that an exclamation mark is present if you want to exclude the driver. Many of the drivers can be used only on certain operating systems (see notes in drivers.list), so include only the drivers you plan to use. PGPLOT can later be reconfigured by restarting the installation at this step. Most installations should include: the null device (/NULL), PostScript printers (/PS, /VPS, /CPS, and /VCPS), Tektronix terminals (/TEK, /XTERM, and possibly other variants), and, if the X window system is available on the target, the X window drivers (/XWIN, /XSERV). You may also wish to include drivers for GIF files (/GIF, /VGIF) or some of the other printers. cd /usr/local/pgplot cp /root/pgplot/drivers.list . vi drivers.list (or use your preferred editor) Note: If you select either the Motif widget driver (XMDRIV) or the Tk/Tcl widget driver (TKDRIV), the installation procedure will install additional files and demonstration programs. Do not select these drivers unless you are planning to develop programs that will use them. For further information see the appropriate documentation: * XMDRIV * TKDRIV 5. Create the makefile The PGPLOT installation procedure for UNIX uses a script, called makemake, to generate a standard UNIX makefile for your operating system, compilers, and list of selected PGPLOT device drivers. Operating-system and compiler information is obtained from a configuration file. Configuration files are available for the following systems. If your configuration is not one of those listed, or if you have trouble using the generated makefile, see below for information about creating your own configuration file. In the following table, Arg#2 is a code for the operating system, and Arg#3 is a code for the Fortran and C compilers. For more information about the supported systems, see the file pgplot/sys_*/aaaread.me, where * stands for one of the options for Arg#2. Arg#2 Arg#3 ------ ------ aix xlf_cc alliant fortran_cc bsd g77_gcc convex fc_cc cray cf77_cc epix2 f77_cc (Control Data EP/IX 2.x) freebsd f77_cc fujitsu uxpm_frt_cc fujitsu uxpv_frt_cc hp fort77_c89 hp fort77_gcc irix f77_cc linux absoft_gcc linux f77_gcc linux g77_elf linux g77_gcc next af77_cc next f2c_cc next g77_cc next gf77_cc osf1 f77_cc osf1 f77_cc_shared sol2 f77_cc (Solaris 2.x, SunOs 5.x) sol2 f77_gcc sol2 f90_cc sol2 g77_gcc sun4 f77_acc (SunOS 4.x) sun4 f77_cc sun4 f77_gcc ultrix f77_cc If your system is one of those listed, proceed as follows: Make the target directory your current default directory, e.g., cd /usr/local/pgplot Execute the script makemake from the distribution directory: e.g., /root/pgplot/makemake /root/pgplot sun4 The first argument supplied to makemake is the name of the distribution directory. The second argument is the name of the operating system (Arg#2 from the above table); if you omit it or supply an unrecognized name, makemake will indicate the allowed values. On some operating systems, where more than one Fortran or C compiler is available, a third argument is required (Arg#3 from the above table); usually this is composed of the two compiler names separated by an underscore. If you omit it, makemake will indicate the allowed values. Once you have supplied valid arguments, makemake may complain that it can't find the drivers.list file. Go back to step 4! Example % ../pgplot/makemake ../pgplot sol2 f77_gcc For additional information, read file ../pgplot/sys_sol2/aaaread.me Reading configuration file: ../pgplot/sys_sol2/f77_gcc.conf Selecting uncommented drivers from ./drivers.list Found drivers GIDRIV NUDRIV PPDRIV PSDRIV TKDRIV TTDRIV WDDRIV XMDRIV XWDRIV Creating make file: makefile Determining object file dependencies. % The script makemake generates a file makefile for subsequent use, a Fortran file grexec.f that calls the selected device drivers, and a text file rgb.txt that contains color definitions for use by routine PGSCRN. (If you already have a file rgb.txt, possibly modified with your own custom definitions, makemake does not modify it.) It also copies two Fortran include files that will be needed during compilation. So at this stage you will have at least the following files: drivers.list grexec.f grpckg1.inc makefile pgplot.inc rgb.txt If your UNIX system is not one of the supported systems listed above, create your own configuration file in the target directory, with name local.conf. It is best to copy one of the configuration files provided (from pgplot/sys_*/*.conf, and then edit it following the comments in the file. The makemake procedure will use local.conf if it exists in the current directory, and if you do not specify Arg#3. Note that you must still specify Arg#2 (operating system). For more information about configuration files, see Porting PGPLOT, or consult tjp@astro.caltech.edu. 6. Use `make' to compile the code Now use the UNIX make command to compile the PGPLOT library following the instructions in makefile: make By default, make will generate: an object-module library, libpgplot.a; a shareable library (if possible on the selected operating system), the binary PGPLOT font file grfont.dat, the demonstration programs pgdemo*, and a documentation file pgplot.doc. In addition, if the /XWIN and/or /XSERV driver was selected in step 4, it will generate a program pgxwin_server, and if the /XDISP driver was selected, it will generate a program pgdisp. If this step proceeds satisfactorily, you may want to type make clean to remove unneeded intermediate files. You will then have the following files in the current directory: drivers.list grexec.f grfont.dat (binary font file)* libpgplot.a (PGPLOT library)* libpgplot.so (shared library, optional)* makefile pgdemo1 ... pgdemo16 (demonstration programs) pgdisp (required by /XDISP driver)* pgplot.doc (ASCII documentation file) pgxwin_server (required by /XWIN driver)* rgb.txt (color name database)* If you requested XMDRIV or TKDRIV, you will also have some of the following files: pgmdemo (executable demo program) libXmPgplot.a (object library required by PGPLOT/Motif applications)* XmPgplot.h (header file required by PGPLOT/Motif applications)* libtkpgplot.a (object library required by PGPLOT/Tk applications)* pgtkdemo (executable demo program) pgtkdemo.tcl (script used by demo program) tkpgplot.h (header file required by PGPLOT/Tk applications)* If you want to copy the compiled version of PGPLOT to another directory, you must copy at least the files marked with an asterisk (*). The documentation file contains the PGPLOT subroutine descriptions, which are also available in the manual. 7. Install the C binding Optionally, install and test the C binding for PGPLOT. This requires an ANSI C compiler (that understands function prototypes) and is not available on all systems. make cpg This creates three files: cpgplot.h (ANSI C header file) libcpgplot.a (library containing the C binding) cpgdemo (demonstration program) 8. Run the demonstration programs Run the demonstration programs on your selected devices and verify that they run satisfactorily. Before running any PGPLOT program, you must ensure that the environment variable PGPLOT_DIR is correctly defined. This is the name of the directory in which PGPLOT will look for the files grfont.dat and rgb.txt (unless environment variables PGPLOT_FONT and PGPLOT_RGB are defined to override this default behavior), and, if needed, the X-window server program pgxwin_server: UNIX csh: setenv PGPLOT_DIR /usr/local/pgplot/ UNIX sh: PGPLOT_DIR="/usr/local/pgplot/"; export PGPLOT_DIR It is also convenient, but not essential, to define a default PGPLOT device with environment variable PGPLOT_DEV, e.g. UNIX csh: setenv PGPLOT_DEV /xwin Other PGPLOT environment variables are described in the manual. When using a UNIX shared library (e.g., on Solaris 2.x), you may also need to put the PGPLOT directory in your loader search path, defined in environment variable LD_LIBRARY_PATH. To run a program, type its name (with directory if the current directory is not in your path): ./pgdemo1 All the demonstration programs prompt for a device name and type. Type a question mark ? to see a list of the available device types and verify that PGPLOT has been configured properly. Points to check for: the PGPLOT program correctly reads the font file and displays superscripts, subscripts and special characters (pgdemo2); the PGPLOT program can read the color database (pgdemo10); on interactive devices, the cursor works correctly (pgdemo5, pgdemo6). To test the PGPLOT Motif widget driver, run pgmdemo in the same way as the other demonstration programs. You must first ensure that an X-window display is available and that environment variable PGPLOT_DIR is correctly defined. To test the PGPLOT Tk/Tcl widget driver, type pgtkdemo pgtkdemo.tcl See the documentation for the driver for more information. 9. Install documentation files (optional) The standard installation procedure creates an ASCII text file containing synopses of all the PGPLOT subroutines: pgplot.doc. A documentation file in HTML format that can be displayed with a Web browser or an HTML reader can be created by typing: make pgplot.html This file is created by executing a perl program to extract the documentation from the source code. If you do not have perl installed on your system, you can access the file at URL http://astro.caltech.edu/~tjp/pgplot/subroutines.html. You may need to edit the first line of file pgplot/makehtml to include the correct commands for invoking perl on your system. A documentation file in LaTeX format (Appendix A of the manual) can be created by typing make pgplot-routines.tex This file is also created by executing a perl program to extract the documentation from the source code. You may need to edit the first line of file pgplot/maketex to include the correct commands for invoking perl on your system. To print this file, you will need to run LaTeX to create a dvi file and a dvi interpreter to print it, e.g. (on Unix systems) latex pgplot-routines dvips pgplot-routines -o 10. Install the library of obsolete routines (optional) The library libpgobs.a includes some obsolete PGPLOT routines. If you have old programs that use these routines, you can install the library by make libpgobs.a However, these routines will not be included in future versions of PGPLOT, so you should rewrite your programs to avoid their use. ---------------------------------------------------------------------------- PGPLOT Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1997 California Institute of Technology pgplot/install-vms.txt010064400040640000322000000242540635127255300155630ustar00tjpcitmbr00000400000017PGPLOT Installation Instructions: VMS systems Version 5.2.0 Note: The following instructions refer to two directories, the distribution (source) directory which will contain the PGPLOT source code directory tree, and the binary directory in which the machine-specific libraries, data files, and demonstration programs will be created. It is recommended that you create new, empty directories for these. They should not be the same directory. In the examples below, these directories are named USR:[LOCAL.PGPLOT] (distribution directory) USR:[LOCAL.PGBIN] (binary directory) but you can use any convenient names. Unusual (system) privileges are not required to install PGPLOT, assuming you have write access to the directories. In a mixed VAX-Alpha cluster, you can use a single distribution directory, but you will need two binary directories, one for each architecture. The distribution directory may be deleted after the installation has been competed, but it will be needed if you later decide to select different device drivers.. 1. Copy the distribution file Copy the distribution file by anonymous ftp from Caltech. Use anonymous ftp (user: anonymous, password: your id username@machine) to node astro.caltech.edu (131.215.240.1). The distribution file is a UNIX tar file compressed with Gzip. Issue the following ftp commands to retrieve the file: cd pub/pgplot binary get pgplot5.2.tar.gz pgplot.tar-gz (Note that you need to provide a VMS-compatible output file name in the get command.) 2. Decompress the files You will need two programs to decompress and extract the contents of the distribution file: gunzip and vmstar. These programs are not part of VMS, but are widely available on the Internet, e.g., at http://www.openvms.digital.com/openvms/freeware/cd.html Use gunzip to decompress the distribution file, e.g., $ gunzip pgplot.tar-gz Then use vmstar to extract the contents of the archive: $ set default USR:[LOCAL} $ vmstar/extract/verbose pgplot.tar OR $ vmstar xvf pgplot.tar $ delete pgplot.tar; This will create a subdirectory [.PGPLOT] (and lower-level subdirectories) in the current directory, e.g., USR:[LOCAL.PGPLOT...]. Make sure that your current directory is where you want to create the ``PGPLOT distribution'' directory tree. 3. Create the binary directory Create a writable directory in which the PGPLOT library and associated files will be created. One such directory is needed for each different binary system; e.g., you may want separate directories for VAX and Alpha. $ create/directory USR:[LOCAL.PGBIN] $ set default USR:[LOCAL.PGBIN] Do not try to create the PGPLOT library in the source (``distribution'') directory. 4. Select device drivers Configure PGPLOT by selecting device drivers from the available list. First copy the file drivers.list from the distribution directory to the binary directory, and then use a text editor to select device drivers. This file contains one line for each available device driver: delete the exclamation mark (!) at the beginning of the line to include the driver, or ensure that an exclamation mark is present if you want to exclude the driver. Many of the drivers can be used only on certain operating systems (see notes in drivers.list), so include only the drivers you plan to use. PGPLOT can later be reconfigured by restarting the installation at this step. Most installations should include: the null device (/NULL), PostScript printers (/PS, /VPS, /CPS, and /VCPS), Tektronix terminals (/TEK, /XTERM, and possibly other variants), and, if the X window system (DECwindows) is available, the X window drivers (/XWIN, /XSERV). You may also wish to include drivers for GIF files (/GIF, /VGIF) or some of the other printers. $ copy USR:[LOCAL.PGPLOT]drivers.list [] $ edit drivers.list 5. Compile the library and demonstration programs Execute the script install.com from the VMS subdirectory of the distribution directory, e.g.: $ @USR:[LOCAL.PGPLOT.SYS_VMS]install USR:[LOCAL.PGPLOT] The first argument supplied to install is the name of the distribution directory. The script will attempt to determine your machine architecture (VAX or Alpha) and compile appropriate code. The script has been tested under several versions of VMS, but if you have problems, you may need to edit the script. The install script issues messages as it proceeds: it usually takes quite a long time. It should generate the following files: DRIVERS.LIST GREXEC.F GRFONT.DAT GRPCKG.OLB GRPSHR.EXE GRPSHR.OLB PGDEMO1.EXE ... PGDEMO16.EXE PGXWIN_SERVER.EXE RGB.TXT The script assumes that you have the current DEC Fortran and C compilers installed. A C compiler is required for XWDRIV and X2DRIV and the associated programs PGXWIN_SERVER and PGDISP, and for generating the C wrapper library CPGPLOT.OLB. If you don't have the DEC C compiler, the script will have to be modified. The script may fail if you redefine any of the common DCL commands like PURGE or DELETE. Note: Demonstration program pgdemo14 is compiled incorrectly by the DEC Fortran 6.2 compiler when optimization is enabled; the symptom is that the labels like "Number of Vertices:" do not appear on the screen. The problem is solved by disabling optimization. 6. Compile the optional components C wrapper library To install the optional C wrapper library, proceed as follows. $ @USR:[LOCAL.PGPLOT.SYS_VMS]install USR:[LOCAL.PGPLOT] CPG This creates three files: CPGPLOT.H (ANSI C header file) CPGPLOT.OLB (library containing the C binding) CPGDEMO.EXE (demonstration program) PGDISP program The PGDISP program is required if you selected the /XDISP device driver. Use of this driver is not recommended: you should use the standard X Window driver (/XWIN or /XSERV) instead. $ @USR:[LOCAL.PGPLOT.SYS_VMS]install USR:[LOCAL.PGPLOT] PGDISP This adds one file, PGDISP.EXE. The PGDISP program sometimes gives compilation problems. Most of these are non-fatal warnings that can be ignored. Motif support and example files If you plan to develop Motif applications that use the PGPLOT widget, or if you want to inspect a sample Motif application, you will need to do this step. You must first: (a) ensure that the Motif header files and libraries are installed on your system; (b) select XMDRIV in drivers.list before installing the PGPLOT library; and (c) install the C wrapper library. Execute the following command: $ @USR:[LOCAL.PGPLOT.SYS_VMS]install USR:[LOCAL.PGPLOT] PGMDEMO This creates five files: PGMDEMO.EXE (executable demo program) PGMOTIF.OPT (linker options file for linking PGPLOT/Motif applications) PGXWIN.OBJ (object module required by PGPLOT/Motif applications) XMPGPLOT.OBJ (object module required by PGPLOT/Motif applications) XMPGPLOT.H (header file required by PGPLOT/Motif applications) (This step may not work on all VMS systems: there are many differences between the various available versions of the DEC C compiler and DECwindows Motif. If you get error messages, you may need to modify file [local.pgplot.sys_vms]make_pgmdemo.com.) 7. Define logical names Before running any PGPLOT program, you must ensure that the following logical names are correctly defined. The logical names may be placed in the process table or the system table. It may be convenient to place the definitions in LOGIN.COM. GRPSHR This should point to the PGPLOT shared library, GRPSHR.EXE, with complete directory information, e.g., $ define GRPSHR PGPLOT_DIR:GRPSHR.EXE If this logical name is not defined, RUN will look for GRPSHR.EXE in the system library directory (SYS$LIBRARY). PGPLOT_DIR This is the name of the directory in which PGPLOT will look for the files grfont.dat and rgb.txt (unless logical names PGPLOT_FONT and PGPLOT_RGB are defined to override this default behavior), and, if needed, the X-window server program pgxwin_server: $ define PGPLOT_DIR USR:[LOCAL.PGBIN] PGPLOT_DEV It is also convenient, but not essential, to define a default PGPLOT device with logical name PGPLOT_DEV, e.g. $ define PGPLOT_DEV "/xwin" LNK$LIBRARY If you develop PGPLOT programs, you can arrange for the linker to automatically scan the PGPLOT library by naming GRPSHR.OLB in one of the LNK$LIBRARY* logical names, e.g. $ define LNK$LIBRARY PGPLOT_DIR:GRPSHR.OLB If you do not do this, you will need to include this library (note: GRPSHR.OLB, not GRPSHR.EXE) in your LINK commands. Other PGPLOT logical names (environment variables) are described in the manual. 8. Run the demonstration programs Run the demonstration programs on your selected devices and verify that they run satisfactorily. To run a program, use the RUN command: $ run pgdemo1 $ run pgdemo2 ... $ run cpgdemo ! optional component $ run pgmdemo ! optional component All the demonstration programs prompt for a device name and type. Type a question mark ? to see a list of the available device types and verify that PGPLOT has been configured properly. Points to check for: the PGPLOT program correctly reads the font file and displays superscripts, subscripts and special characters (pgdemo2); the PGPLOT program can read the color database (pgdemo10); on interactive devices, the cursor works correctly (pgdemo5, pgdemo6). 9. Install the documentation files Unlike the UNIX installation procedure, the VMS installation procedure does not generate documentation. A list of subroutine synopses is available in a variety of formats by anonymous ftp from ftp://astro.caltech.edu/pub/pgplot/DOC/: * pgplot.doc (plain ASCII file) * pgplot.hlp (VMS help format) * pgplot.html (HTML [WWW] format) * pgplot.ps (PostScript) The help file can be installed in a VMS help library with a DCL command like the following: $ library/insert/help pgplot.hlb pgplot.hlp ---------------------------------------------------------------------------- PGPLOT Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1997 California Institute of Technology pgplot/pgmf/pgrdmf.f010064400040640000322000000204240635127275000151220ustar00tjpcitmbr00000400000017 PROGRAM EXPGMF C----------------------------------------------------------------------- C This is a simple program to examine the pictures contained in a C PGPLOT metafile, displaying them one at a time on a selected PGPLOT C device. Options are provided for converting color pictures to C monochrome or grey scale. C----------------------------------------------------------------------- CHARACTER*80 FILE CHARACTER*8 OPT INTEGER I, ISTAT, NPICT, PGOPEN C FILE = 'pgplot.pgmf' C C Scan the metafile to find number of pictures C CALL PGEXMF(FILE, NPICT, ISTAT) WRITE (*,*) 'Number of pictures in metafile:', NPICT C C Open output graphics device C ISTAT = PGOPEN('?') IF (ISTAT.LT.1) STOP CALL PGASK(.FALSE.) C C Display requested picture(s) C WRITE (*,*) 'Options (M for monochrome, G for grey scale):' READ (*, '(A)') OPT 10 WRITE (*,*) 'Enter number of picture to display: ' READ (*,*, END=20) I IF (I.LT.1) GOTO 20 IF (I.GT.NPICT) GOTO 10 CALL PGPAGE CALL PGSVP(0.0, 1.0, 0.0, 1.0) CALL PGRDMF(FILE, OPT, I, ISTAT) GOTO 10 C C Close output graphics device C 20 CALL PGCLOS C----------------------------------------------------------------------- END C*PGRDMF -- read and display a picture from a PGPLOT metafile C%void cpgrdmf(char *file, char *opt, int npict, int *istat); C+ SUBROUTINE PGRDMF (FILE, OPT, NPICT, ISTAT) CHARACTER*(*) FILE, OPT INTEGER NPICT, ISTAT C C This routine reads a PGPLOT metafile from a disk file and displays C it in the current viewport. C C Arguments: C FILE (input) : name of metafile to read C OPT (input) : string of single-character options (see below) C NPICT (input) : sequence number of picture to display C ISTAT (output) : receives 0 if file is read successfully; >0 if C an error occurs (e.g., file not found, wrong C format) C C Options: C M : display in monochrome, using color indices 0 and 1; C all color information in the metafile will be ignored. C G : display in grey scale: colors in the metafile will be C converted to shades of grey. C D : debug: report unrecognized entries in the metafile. C-- C 3-Jun-1997 - new routine (TJP). C----------------------------------------------------------------------- INTEGER MAXPOL PARAMETER (MAXPOL=1000) INTEGER UNIT, IER, I, N1, N2, N3, N4, NPTS, NFND, LW, N, CI INTEGER GROPTX, GRCTOI LOGICAL MONO, GREY, DEBUG REAL X, Y, X1, Y1, X2, Y2, SCALE, POLX(MAXPOL), POLY(MAXPOL) REAL SHADE CHARACTER REC*80, OP C MONO = INDEX(OPT,'M').NE.0 .OR. INDEX(OPT,'m').NE.0 GREY = INDEX(OPT,'G').NE.0 .OR. INDEX(OPT,'g').NE.0 DEBUG = INDEX(OPT,'D').NE.0 .OR. INDEX(OPT,'d').NE.0 C C Open file and check that it is a PGPLOT metafile C CALL GRGLUN(UNIT) IER = GROPTX(UNIT, FILE, 'pgplot.pgmf', 0) IF (IER.NE.0) THEN ISTAT = 1 CALL GRWARN('Cannot open PGPLOT metafile:') CALL GRWARN(FILE(1:LEN(FILE))) CALL GRFLUN(UNIT) RETURN END IF READ (UNIT, '(A)', IOSTAT=IER) REC IF (IER.NE.0 .OR. REC(1:5).NE.'%PGMF') THEN ISTAT = 2 CALL GRWARN('File is not a PGPLOT metafile:') CALL GRWARN(FILE(1:LEN(FILE))) CLOSE (UNIT=UNIT) CALL GRFLUN(UNIT) RETURN END IF C C Skip to start of requested picture C N = 0 50 READ (UNIT, '(A)', IOSTAT=IER) REC IF (IER.NE.0) THEN ISTAT = 3 CALL GRWARN('Requested picture not found in PGPLOT metafile:') CALL GRWARN(FILE(1:LEN(FILE))) CLOSE (UNIT=UNIT) CALL GRFLUN(UNIT) RETURN END IF IF (REC(1:1).NE.'B') GOTO 50 N = N+1 IF (N.LT.NPICT) GOTO 50 C C Display this picture C CALL PGBBUF CALL PGSAVE 100 CONTINUE OP = REC(1:1) I = 2 N1 = GRCTOI(REC, I) I = I+1 N2 = GRCTOI(REC, I) I = I+1 N3 = GRCTOI(REC, I) I = I+1 N4 = GRCTOI(REC, I) IF (OP.EQ.'L') THEN C -- line segment X = X + REAL(N1) Y = Y + REAL(N2) CALL PGDRAW(X, Y) ELSE IF (OP.EQ.'M') THEN C -- move pen X = REAL(N1) Y = REAL(N2) CALL PGMOVE(X, Y) ELSE IF (OP.EQ.'D') THEN C -- dot X = REAL(N1) Y = REAL(N2) CALL PGPT1(X, Y, -1) ELSE IF (OP.EQ.'S') THEN C -- marker X = REAL(N2) Y = REAL(N3) CALL PGPT1(X, Y, N1) ELSE IF (OP.EQ.'I') THEN C -- set color index IF (MONO) THEN CI = 1 IF (N1.EQ.0) CI = 0 ELSE CI = N1 END IF CALL PGSCI(CI) ELSE IF (OP.EQ.'W') THEN C -- set line width C (N1 is width in PGMF units; convert to unit 1/200 inch) LW = NINT(200.0*N1/SCALE) IF (LW.LT.1) LW = 1 CALL PGSLW(LW) ELSE IF (OP.EQ.'Y') THEN C -- begin polygon NPTS = N1 NFND = 0 ELSE IF (OP.EQ.'X') THEN C -- polygon vertex NFND = NFND +1 IF (NFND.LE.MAXPOL) THEN POLX(NFND) = REAL(N1) POLY(NFND) = REAL(N2) END IF IF (NFND.EQ.NPTS) THEN CALL PGPOLY(MIN(NPTS,MAXPOL), POLX, POLY) NPTS = 0 END IF ELSE IF (OP.EQ.'R') THEN C -- rectangle CALL PGRECT(REAL(N1), REAL(N3), REAL(N2), REAL(N4)) ELSE IF (OP.EQ.'C') THEN C -- set color representation IF (MONO) THEN CONTINUE ELSE IF (GREY) THEN SHADE = (0.30*N2 + 0.59*N3 + 0.11*N4)/255.0 CALL PGSCR(N1, SHADE, SHADE, SHADE) ELSE CALL PGSCR(N1, : REAL(N2)/255.0, REAL(N3)/255.0, REAL(N4)/255.0) END IF ELSE IF (OP.EQ.'B') THEN C -- begin picture CALL PGWNAD(0.0, REAL(N2), 0.0, REAL(N3)) X = 0.0 Y = 0.0 C -- find device scale (PGMF units per inch) CALL PGQVP(1, X1, X2, Y1, Y2) SCALE = REAL(N2)/(X2-X1) ELSE IF (OP.EQ.'E') THEN C -- end picture GOTO 200 ELSE IF (REC(1:1).EQ.'%') THEN C -- comment CONTINUE ELSE IF (DEBUG) THEN CALL GRWARN('Bad entry in metafile: '//REC(1:16)) END IF END IF READ (UNIT, '(A)', IOSTAT=IER) REC IF (IER.NE.0) GOTO 200 GOTO 100 200 CONTINUE CALL PGUNSA CALL PGEBUF CLOSE (UNIT=UNIT) CALL GRFLUN(UNIT) RETURN END C*PGEXMF -- determine properties of PGPLOT metafile C%void cpgexmf(char *file, int *npict, int *istat); C+ SUBROUTINE PGEXMF (FILE, NPICT, ISTAT) CHARACTER*(*) FILE INTEGER NPICT, ISTAT C C Arguments: C FILE (input) : name of metafile to read C NPICT (output) : number of pictures in metafile C ISTAT (output) : receives 0 if file is read successfully; 1 if C an error occurs (e.g., file not found, wrong C format) C-- C 3-Jun-1997 - new routine (TJP). C----------------------------------------------------------------------- INTEGER UNIT, IER INTEGER GROPTX CHARACTER REC*80 C CALL GRGLUN(UNIT) IER = GROPTX(UNIT, FILE, 'pgplot.pgmf', 0) IF (IER.NE.0) THEN ISTAT = 1 CALL GRWARN('Cannot open PGPLOT metafile:') CALL GRWARN(FILE(1:LEN(FILE))) CALL GRFLUN(UNIT) RETURN END IF READ (UNIT, '(A)', IOSTAT=IER) REC IF (IER.NE.0 .OR. REC(1:5).NE.'%PGMF') THEN ISTAT = 2 CALL GRWARN('File is not a PGPLOT metafile:') CALL GRWARN(FILE(1:LEN(FILE))) CLOSE (UNIT=UNIT) CALL GRFLUN(UNIT) RETURN END IF NPICT = 0 100 CONTINUE READ (UNIT, '(A)', IOSTAT=IER) REC IF (IER.NE.0) GOTO 200 IF (REC(1:1).EQ.'B') THEN NPICT = NPICT+1 END IF GOTO 100 200 CONTINUE CLOSE (UNIT=UNIT) CALL GRFLUN(UNIT) RETURN END pgplot/pgmf/aaaread.me010064400040640000322000000014360635127353300153770ustar00tjpcitmbr00000400000017This directory (pgplot/pgmf) contains information about PGPLOT metafiles. PGPLOT metafiles can be created using the driver pgdriv.f (device type /PGMF). For more information, see http://astro.caltech.edu/~tjp/pgplot/pgdriv.html The program in this directory (pgrdmf.f) is an example of a program to read a PGPLOT metafile and display it on another device. It is written in standard Fortran-77, and should be compiled and linked with the PGPLOT library like any other PGPLOT application program. This is an experimental program in version 5.2.0 of PGPLOT. Depending on feedback from users, the design of the program and the format of PGPLOT metafiles may change in future versions of PGPLOT. I hope to fix the format and provide standard reading routines in version 5.3 of PGPLOT. Tim Pearson pgplot/sys_sol2/f77_gcc.conf010064400040640000322000000106310724407324600164060ustar00tjpcitmbr00000400000017# The Solaris f77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/dt/include $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL -I/usr/local/include" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="-Irivet/tcl -Irivet/tk -Irivet/rivet $XINCL" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -PIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-xl -u -O" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -fPIC -O -Dsolaris" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 -lnsl -lsocket \`\$(SRC)/cpg/libgcc_path.sh\` -lgcc -lm -R\`pwd\`:/usr/openwin/lib:/opt/SUNWspro/lib" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/dt/lib -lXm -L/usr/openwin/lib -lXt $LIBS -R/usr/dt/lib" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -R/usr/local/lib -ltk and -ltcl. TK_LIBS="-L/usr/openwin/lib -L/usr/local/lib -R/usr/local/lib -ltk8.3 -ltcl8.3 $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -ztext -G -i" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="$LIBS -lc -lm" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sol2/f77_cc.conf010064400040640000322000000106350724407324600162430ustar00tjpcitmbr00000400000017# The Solaris f77 FORTRAN compiler and Solaris cc ANSI C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/dt/include $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL -I/usr/local/include" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="-I/usr/local/rivet/tcl -I/usr/local/rivet/tk -I/usr/local/rivet/rivet $XINCL" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -PIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-xl -u -O" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -KPIC -O -Dsolaris" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 -lnsl -lsocket -lm -R\`pwd\`:/usr/openwin/lib:/opt/SUNWspro/lib" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/dt/lib -lXm -L/usr/openwin/lib -lXt $LIBS -R/usr/dt/lib" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -R/usr/local/lib -ltk and -ltcl. TK_LIBS="-L/usr/openwin/lib -L/usr/local/lib -R/usr/local/lib -ltk8.3 -ltcl8.3 $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -z text -G -i" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="$LIBS -lc -lm" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sol2/f90_cc.conf010064400040640000322000000104340724407324600162330ustar00tjpcitmbr00000400000017# The Solaris f90 1.1 FORTRAN compiler and Solaris cc ANSI C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/dt/include $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL -I/usr/local/include" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f90" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-fixed -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fixed -O" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -KPIC -O -Dsolaris" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 -lnsl -lsocket -lm -R\`pwd\`:/usr/openwin/lib:/opt/SUNWspro/lib" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/dt/lib -lXm -L/usr/openwin/lib -lXt $LIBS -R/usr/dt/lib" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -R/usr/local/lib -ltk and -ltcl. TK_LIBS="-L/usr/openwin/lib -L/usr/local/lib -R/usr/local/lib -ltk8.3 -ltcl8.3 $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sol2/g77_gcc.conf010064400040640000322000000104330724407324600164070ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/dt/include $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="$XINCL -I/usr/local/include" # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall -fPIC" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -fPIC -O -Dsolaris" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/dt/lib -lXm -L/usr/openwin/lib -lXt $LIBS -R/usr/dt/lib" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -R/usr/local/lib -ltk and -ltcl. TK_LIBS="-L/usr/openwin/lib -L/usr/local/lib -R/usr/local/lib -ltk8.3 -ltcl8.3 $LIBS -ldl -lsocket -lnsl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -ztext -G -i" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="$LIBS -lc -lm" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sol2/aaaread.me010064400040640000322000000064120654626021400162200ustar00tjpcitmbr00000400000017pgplot/sys_sol2 The *.conf files in this directory are for use with Solaris 2.x (SunOS 5.x). Use the *.conf files in pgplot/sys_sun4 for SunOS v4.1.x (Solaris version 1.x). f77_cc.conf: for the Solaris f77 FORTRAN compiler and Solaris (SunWpro) cc ANSI C compiler. NOTE: this will not work if "cc" on your system invokes the old BSD (non-ANSI) C compiler. f77_gcc.conf: for the Solaris f77 FORTRAN compiler and Gnu gcc C compiler. g77_gcc.conf: for the GNU g77 FORTRAN compiler and Gnu gcc C compiler. NOTE: g77 will not compile some of the very non-standard drivers, including HGDRIV and LJDRIV. The drivers should be rewritten. f90_cc.conf: for the Solaris f90 1.1 FORTRAN compiler and Solaris cc ANSI C compiler. (Provided by Ricardo Piriz.) This does not create a shared library: The f90 manual is not very clear about it, but it says "...this release does not provide a way to guarantee that code is position independent (no -PIC option)". The compiler warns about INTEGER*2 variables, but compiles them (correctly) as INTEGER*4. Many of the device drivers cannot be compiled with this compiler; so far, only the NULL, POSTSCRIPT, Xterm, and X-window drivers (nudriv, psdriv, ttdriv, xwdriv)have been tested. The effect of promotion of INTEGER*2 to INTEGER*4 is to double the size of the binary font file grfont.dat, and it also means that you cannot use an f77 version of grfont.dat with an f90 version of pgplot, or vice versa. ----------------------------------------------------------------------- POTENTIAL PROBLEMS (1) You must use the Solaris version of "ld", not the ucb version. Symptom: when running a pgplot program, you get the following message: % pgdemo1 ld.so.1: pgdemo1: fatal: libucb.so.1: can't open file: errno=2 killed Check which version of "ld" you are using by executing the following command: % which ld You should get a result like: /usr/ccs/bin/ld However, if the command shows a filename with "ucb" in it, you are picking up the wrong version. Solaris 2.5 does not require anything in the "ucb" directories, but they are provided for backwards compatibility with SunOS. You will need to change your path (PATH environment variable) (before installing PGPLOT) to make sure that the Solaris directories are scanned before any ucb directories. My PATH does not include the ucb directories at all: bottom% echo $PATH /usr/openwin/bin:/opt/SUNWspro/bin:/usr/bin:/usr/local/bin:/usr/sbin:/usr/ccs/bin:/home/bottom/tjp/bin:. I do not know why Sun distributes two versions of "ld" with Solaris, or why they are imcompatible. ------------------------------------------------------------------------ OTHER NOTES A user has successfully linked a program compiled with Craysoft f90 with PGPLOT compiled with Sun f77; but it required a large number of libraries to be included: LIBS = -lm -L/usr/local/SUNWspro/lib -lF77 -lF77_mt -L/usr/local/SUNWspro/SC3.0.1/lib -lM77 -lm_mt -lmtsk -lmopt -lsunmath -lsunmath_mt -L/usr/openwin/lib -lX11 -lnsl -lsocket -L$(PGPLOT_DIR) -lpgplot -lcpgplot -ltkpgplot -L/usr/local/tk8.0/unix -ltk8.0 -L/usr/local/tcl8.0/unix -ltcl8.0 -L/usr/local/SUNWspro/SC3.0.1/libp -lF77 -lF77_mt -lm_mt -lsunmath -lsunmath_mt ------------------------------------------------------------------------ Tim Pearson 30 Jun 1998 pgplot/sys_solx86/aaaread.me010064400040640000322000000022430643144575000165050ustar00tjpcitmbr00000400000017pgplot/sys_solx86 The *.conf files in this directory are for use with x86 Solaris (Solaris for a PC). g77_gcc.conf: for the GNU g77 FORTRAN compiler and Gnu gcc C compiler. NOTE: g77 will not compile some of the very non-standard drivers, including HGDRIV and LJDRIV. The drivers should be rewritten. This configuration file does not make a shared library. If anybody knows how to do this, please tell me. Tim Pearson ------------------------------------------------------------------------ Date: Tue, 4 Nov 1997 11:53:28 -0800 (PST) From: Karl Gebhardt To: tjp@astro.caltech.edu Subject: PGPLOT on x86 Hi Tim, I just installed PGPLOT on x86 Solaris (Solaris for a PC). Everything is fine and is working. I had to change the makefile a little though. I had to take out the fortran compile switches, so now I just have -O: FFLAGC=-O and I had to not use the shared library since it would always fail on that, so I now only have lib : libpgplot.a I haven't bothered to figure out exactly what happened here, but everything seems to be fine now. The problem may be something that I am doing wrong. I'm using g77 and gcc. Karl gebhardt@ucolick.org pgplot/sys_solx86/g77_gcc.conf010064400040640000322000000103610724407255200166720ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/dt/include $XINCL" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-Wall -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -fpic -O -Dsolaris" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/dt/lib -lXm -L/usr/openwin/lib -lXt $LIBS -R/usr/dt/lib" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk8.3 -ltcl8.3 -L/usr/openwin/lib $LIBS -ldl -lsocket -lnsl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB=":" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. # SHARED_LIB="libpgplot.so" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -ztext -G -i" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="$LIBS -lc -lm" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sun4/f77_cc.conf010064400040640000322000000102740656367443700162700ustar00tjpcitmbr00000400000017# The SunOS f77 FORTRAN compiler and SunOS cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/local/include" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -PIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-xl -u -O" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -PIC -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O -Dmain=MAIN_" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/local/lib -lXm -L/usr/openwin/lib -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so.1.10" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -assert pure-text" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sun4/f77_gcc.conf010064400040640000322000000103450656367443700164360ustar00tjpcitmbr00000400000017# The SunOS f77 FORTRAN compiler and Gnu gcc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/local/include" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -PIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-xl -u -O" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -fPIC -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O -Dmain=MAIN_" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 \`\$(SRC)/cpg/libgcc_path.sh\` -lgcc -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/local/lib -lXm -L/usr/openwin/lib -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so.1.10" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -assert pure-text" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sun4/f77_acc.conf010064400040640000322000000103010656367443700164200ustar00tjpcitmbr00000400000017# The SunOS f77 FORTRAN compiler and SunOS acc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/openwin/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="-I/usr/local/include" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -PIC -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-xl -u -O" # Mandatory. # The C compiler to use. CCOMPL="acc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -PIC -O" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-O -Dmain=MAIN_" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/openwin/lib -lX11 -lm" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-L/usr/local/lib -lXm -L/usr/openwin/lib -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="libpgplot.so.1.10" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="ld -o $SHARED_LIB -assert pure-text" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/sys_sun4/aaaread.me010064400040640000322000000033450570653664400162460ustar00tjpcitmbr00000400000017pgplot/sys_sun4 The *.conf files in this directory are for use with SunOS v4.1.x (Solaris version 1.x). Use the *.conf files in pgplot/sys_sol2 for Solaris 2.x (SunOS 5.x). USE WITH SUNVIEW PGPLOT is not supported under SunView. It is assumed that you will select the X Window drivers (/XWIN and /XSERV) rather than the SunView driver (/SUN). If you include SVDRIV (the SunView driver) in the configuration, then you will need to include the following additional libraries in the link: -lsuntool -lsunwindow -lpixrect You will also need to have the follwing header files available: #include #include Tim Pearson 16 January 1995 PGPLOT SYSTEM NOTES: SunOS All PGPLOT programs fail when run under SunOS 4.1.x with Fortran 1.3.x. This is due to a bug in the Sun Fortran I/O libraries. With this version of the compiler and Fortran support library (earlier versions are fine), I/O records longer than 8K bytes are not handled correctly. This affects routine grsy00, which is executed when PGPLOT starts up in order to load the font file into memory, and program pgpack which is used to create the binary font file from the text version included in the distribution. A patch, described below, is available from Sun. When the patch is installed, it is not necessary to recompile or relink affected programs. Patch-ID# 100098-02 Keywords: Fortran records 16kb Synopsis: fixes bug in libf77 that aborts on writes >= 16kb records. Date: SunOS release: 4.1 Unbundled Product: Fortran Unbundled Release: 1.3.1 BugId's fixed with this patch: 1042114 Architectures for which this patch is available: sun3 sun4 sun386i Obsoleted by: Fortran 1.4 ____________________________________________________________________________ pgplot/sys_ultrix/f77_cc.conf010064400040640000322000000100650656367444000167160ustar00tjpcitmbr00000400000017# The Ultrix f77 FORTRAN compiler and cc C compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by XADRIV (/xathena). # The arguments needed by the C compiler to locate Xaw, Xt and # X-window include files. ATHENA_INCL="$XINCL" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="f77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-O2 -u" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-O2 -u -assume backslash" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU -O2 -Olimit 600" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="-Dmain=MAIN_ -O2" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="bsd" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt $LIBS" # Optional: Needed by XADRIV (/xathena). # The library-specification flags to use when linking athena # demo programs. ATHENA_LIBS="-lXaw -lXt -lXmu -lXext $LIBS" # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl $LIBS -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR" pgplot/ver521.txt010064400040640000322000000037170724652110600143320ustar00tjpcitmbr00000400000017PGPLOT version 5.2.1 This version is a maintenance release. It introduces no new subroutines or functionality. Tested Systems Version 5.2.1 has been tested on the following systems. * Solaris 2.5.1 (SunOS 5.5.1), GNU Fortran (g77) and C (gcc) 2.8.1 [sol2 g77_gcc]; tested on SPARC Ultra-1; device drivers CGDRIV GIDRIV GLDRIV NUDRIV PPDRIV PSDRIV TKDRIV TTDRIV WDDRIV XMDRIV XWDRIV. Changes to configuration files and system support New systems sys_cygwin sys_gnuwin32 sys_solx86 Modified systems See the appropriate pgplot/sys_*/aaaread.me file for details of changes. Many configuration files (not listed here) have been modified to correct errors and add new configuration variables. sys_aix Modified aaaread.me, xlf_cc.conf; added g77_gcc.conf. sys_hp Added g77_gcc.conf. sys_linux Added f95_gcc.conf (and directory f95_src), fort77_gcc.conf, g77_elf.conf, g77_gcc_aout.conf, nag_gcc.conf and directory nag_src. sys_osf1 Added g77_gcc.conf. sys_win Added gidriv.f and pgpack.f (special versions of these routines for Windows). Modified support routines sys/grgetc.c Removed unused variables. sys/grgmem.c Modified to work with 64-bit systems (or other systems in which a pointer does not fit in an int). Changes to device drivers New device drivers cgdriv Driver for CGM (Computer Graphics Metafile). pndriv Driver for PNG (Portable Network Graphics format). Note: to install this, you must have libpng. xadriv This is a widget driver, like xmdriv, that uses the X-athena widget set instead of the Motif widget set. See the documentation for xmdriv for further information. Modified device drivers Many. Changes to PGPLOT subroutines pgqinf Returns new version number (5.2.1). ---------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1999 California Institute of Technology pgplot/sys_openstep/g77_src/grtermio.c010064400040640000322000000057100567152654400205550ustar00tjpcitmbr00000400000017/* Support routines for terminal I/O. This module defines the following Fortran-callable routines: GROTER, GRCTER, GRWTER, GRRTER. */ #include long int groter_(cdev, ldev, cdev_len) char *cdev; long int *ldev; int cdev_len; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * cdev_len I Used by Fortran compiler to pass character length * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } grcter_(fd) int *fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } grwter_(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; long int *lbuf; int cbuf_len; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return * cbuf_len I Used by Fortran compiler to pass character length */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } grpter_(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int cprom_len, cbuf_len; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read * cbuf_len I Used by Fortran compiler to pass character length */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } pgplot/sys_openstep/g77_src/grgetc.c010064400040640000322000000053600567152654400202010ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) grgetc_(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_openstep/pgview/Makefile010064400040640000322000000020650666526624200202470ustar00tjpcitmbr00000400000017# # Generated by the NeXT Project Builder. # # NOTE: Do NOT change this file -- Project Builder maintains it. # # Put all of your customizations in files called Makefile.preamble # and Makefile.postamble (both optional), and Makefile will include them. # NAME = pgview PROJECTVERSION = 2.6 PROJECT_TYPE = Application LANGUAGE = English NEXTSTEP_APPICON = pgicon.tiff ICONSECTIONS = -sectcreate __ICON app pgicon.tiff GLOBAL_RESOURCES = cross.tiff CLASSES = dispatchobj.m hostobj.m ipanelobj.m pgviewobj.m portobj.m HFILES = dispatchobj.h hostobj.h ipanelobj.h pgviewobj.h portobj.h MFILES = pgview_main.m OTHERSRCS = Makefile MAKEFILEDIR = $(NEXT_ROOT)/NextDeveloper/Makefiles/pb_makefiles CODE_GEN_STYLE = DYNAMIC MAKEFILE = app.make NEXTSTEP_INSTALLDIR = $(HOME)/Apps WINDOWS_INSTALLDIR = /MyApps LIBS = DEBUG_LIBS = $(LIBS) PROF_LIBS = $(LIBS) FRAMEWORKS = -framework AppKit -framework Foundation include $(MAKEFILEDIR)/platform.make -include Makefile.preamble include $(MAKEFILEDIR)/$(MAKEFILE) -include Makefile.postamble -include Makefile.dependencies pgplot/sys_openstep/pgview/PB.project010064400040640000322000000020720666526624100204750ustar00tjpcitmbr00000400000017{ APPCLASS = NSApplication; DYNAMIC_CODE_GEN = YES; FILESTABLE = { CLASSES = (dispatchobj.m, hostobj.m, ipanelobj.m, pgviewobj.m, portobj.m); FRAMEWORKS = (AppKit.framework, Foundation.framework); H_FILES = (dispatchobj.h, hostobj.h, ipanelobj.h, pgviewobj.h, portobj.h); IMAGES = (cross.tiff); INTERFACES = (); OTHER_LINKED = (pgview_main.m); OTHER_SOURCES = (Makefile); }; LANGUAGE = English; LOCALIZABLE_FILES = {}; MAKEFILEDIR = "$(NEXT_ROOT)/NextDeveloper/Makefiles/pb_makefiles"; NEXTSTEP_APPICON = pgicon.tiff; NEXTSTEP_BUILDTOOL = /bin/gnumake; NEXTSTEP_DOCUMENTEXTENSIONS = (); NEXTSTEP_INSTALLDIR = "$(HOME)/Apps"; NEXTSTEP_MAINNIB = NEXTSTEP_pgview.nib; PDO_UNIX_BUILDTOOL = $NEXT_ROOT/NextDeveloper/bin/make; PROJECTNAME = pgview; PROJECTTYPE = Application; PROJECTVERSION = 2.6; WINDOWS_BUILDTOOL = $NEXT_ROOT/NextDeveloper/Executables/make; WINDOWS_INSTALLDIR = /MyApps; WINDOWS_MAINNIB = WINDOWS_pgview.nib; } pgplot/sys_openstep/pgview/cross.tiff010064400040640000322000000004140567152654200206040ustar00tjpcitmbr00000400000017MM* ÿü@@@@@@UTUT@UTUT@@@@@@@@@@@@UWUTÿÿôUWUT@@@@@@|¼@@pgplot/sys_openstep/pgview/demo.c010064400040640000322000000032130666455233000176660ustar00tjpcitmbr00000400000017#include #include #ifdef __STDC__ void nexsup_( int *ifunc, char *cbuf, float *rtmp); #endif #ifdef __STDC__ void main(int argc, char *argv[]) #else void main(argc, argv) int argc; char *argv[]; #endif { char *cbuf=NULL; float rtmp[20]; int ifunc; ifunc=1; printf("demo--Sending ifunc=1 showwind/getsize.\n"); nexsup_(&ifunc, cbuf, rtmp); printf("demo-window size is %f %f resol=%f color=%f\n",rtmp[0],rtmp[1],rtmp[2],rtmp[3]); ifunc=2; rtmp[0]=1.; printf("demo--Sending ifunc=2 beginp/clear\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc, ".20 setgray newpath 50 50 moveto 100 500 lineto stroke", rtmp); ifunc=5; printf("demo--Sending ifunc=5, flush\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc, "newpath 100 100 moveto 100 0 rlineto 0 100 rlineto -100 0 rlineto closepath eofill", rtmp); ifunc=3; printf("demo--Sending ifunc=3, pscode.\n"); nexsup_(&ifunc,"newpath 0 0 moveto 20 20 lineto stroke", rtmp); ifunc=5; printf("demo--Sending ifunc=5, flush\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=4; printf("demo--Sending ifunc=4 read cursor.\n"); nexsup_(&ifunc, cbuf, rtmp); printf("demo--Cursor= %f %f %f\n",rtmp[0],rtmp[1],rtmp[2]); ifunc=6; printf("demo--Sending ifunc=6, end picture\n"); nexsup_(&ifunc, cbuf, rtmp); ifunc=7; printf("demo--Sending ifunc=7, close socket\n"); nexsup_(&ifunc, cbuf, rtmp); exit(0); } pgplot/sys_openstep/pgview/dispatchobj.h010064400040640000322000000010130666663160200212370ustar00tjpcitmbr00000400000017#import #import "pgviewobj.h" @interface dispatchobj : NSObject { NSCursor *crossCursor; pgviewobj *curView; BOOL qdrawing; int iwtype; } - (void)newLand; - (void)newPort; - (void)pgprint; - (void)deactive; - (void)beginp; - (void)cursorat: (float *) xpos and: (float *) ypos char: (int *) ichar; - (void)flushpg; - (void)getwind: (int *) ixdim by: (int *) iydim color: (int *) icol scale: (int *) imag; - (void)pscode: (char *) cbuf; - (void)endp; @end pgplot/sys_openstep/pgview/dispatchobj.m010064400040640000322000000106740666663160600212650ustar00tjpcitmbr00000400000017// dispatch.m--The purpose is to keep track of the currently active plot // view and to route messages from the PGPLOT program there. To do this, // dispatchobj needs to be the target for the Menu items that create // windows. It also needs to be the window delegate. And finally it // needs to receive messages from the Port object (i.e., from the // socket interface to the PGPLOT program). // If PGPLOT is drawing to a window then dispatchobj doe not allow // the user to delete the window. // // 1999-Feb-20 - Update for OpenStep - [AFT] // 1992-Mar-9 - [AFT] //--- #import "dispatchobj.h" #import "ipanelobj.h" @implementation dispatchobj // //--- Class methods ----------------------------------------------------- // - init { NSPoint spot; [super init]; // Scale print jobs to print on one page. [[NSPrintInfo sharedPrintInfo] setHorizontalPagination:NSFitPagination]; [[NSPrintInfo sharedPrintInfo] setVerticalPagination:NSFitPagination]; // Prepare the cross cursor spot.x = 7.0; spot.y = 7.0; crossCursor = [[NSCursor alloc] initWithImage:[NSImage imageNamed:@"cross.tiff"] hotSpot:spot]; // 0=Landscape, 1=portrait iwtype=0; curView=NULL; qdrawing=NO; return self; } // //--- Window delegate --------------------------------------------------- // - (void)windowDidBecomeMain:(NSNotification *)notification // If PGPLOT is actively drawing, then we try to prevent the key window // from changing. This is done so that the key window (i.e., the one // with the back title bar) will denote the currently active plot window. { NSWindow *theWindow = [notification object]; if( qdrawing ) { // If we are drawing, then force the curView view to be the key window. if( [theWindow contentView] != curView) { [[curView window] makeKeyWindow]; } } else { curView=[theWindow contentView]; [curView gettype: &iwtype]; if(iwtype==0) { [[NSPrintInfo sharedPrintInfo] setOrientation:NSLandscapeOrientation]; } else { [[NSPrintInfo sharedPrintInfo] setOrientation:NSPortraitOrientation]; } } return; } - (BOOL)windowShouldClose:(id)sender // Prevent window manager from closing a window in which PGPLOT is // still drawing. { if( !qdrawing || curView != [sender contentView] ) { if ( !qdrawing ) curView=NULL; return YES; } return NO; } // //--- Targets for menu items -------------------------------------------- // - (void)newLand { static NSRect wRect = {{330.0, 230.0},{720.0,535.0}}; pgviewobj *newView; newView = [[pgviewobj alloc] initWithFrame:wRect]; [[newView window] setDelegate:self]; if( !qdrawing ) { curView=newView; iwtype=0; [[NSPrintInfo sharedPrintInfo] setOrientation:NSLandscapeOrientation]; } return; } - (void)newPort { static NSRect wRect = {{500.0, 70.0},{535.0,720.0}}; pgviewobj *newView; newView = [[pgviewobj alloc] initWithFrame:wRect]; [[newView window] setDelegate:self]; if( !qdrawing ) { curView=newView; iwtype=1; [[NSPrintInfo sharedPrintInfo] setOrientation:NSPortraitOrientation]; } return; } - (void)pgprint { [curView print:self]; return; } - (void)showInfo { [[[ipanelobj alloc] init] showit]; return; } - (void)deactive { [NSApp hide:self]; [NSApp unhideWithoutActivation]; return; } // //--- methods called by the Port object --------------------------------- // - (void)beginp { qdrawing=YES; [curView beginp]; return; } - (void)cursorat: (float *) xpos and: (float *) ypos char: (int *) ichar { NSPoint aPoint; aPoint.x= *xpos; aPoint.y= *ypos; [curView readcursor: &aPoint char: ichar cursor:crossCursor]; *xpos= aPoint.x; *ypos= aPoint.y; return; } - (void)flushpg { [curView flushpg]; return; } - (void)getwind: (int *) ixdim by: (int *) iydim color: (int *) icol scale: (int *) imag { if(curView == NULL) { if(iwtype==0) { [self newLand]; } else { [self newPort]; } } [curView getwind:ixdim by:iydim color:icol scale:imag]; return; } - (void)pscode: (char *) cbuf { [curView pscode:cbuf]; return; } - (void)endp { qdrawing=NO; [curView endp]; return; } @end pgplot/sys_openstep/pgview/hostobj.h010064400040640000322000000005310666532722100204170ustar00tjpcitmbr00000400000017#import #import @interface hostobj : Object { Storage *hostlist; NSMenu *hostmenu; id mydispatch; } - initwithdispatch:(id)adispatch; - (void) addhost:(int)iaddr; - (BOOL) queryhost:(int)isuspect; - (NSMenu *) gethostmenu; - (void) removehost:(NSMenuItem *) sender; @end pgplot/sys_openstep/pgview/hostobj.m010064400040640000322000000072050666534433200204330ustar00tjpcitmbr00000400000017// hostobj.m--This object manages the list of hosts that are allowed // to connect. Use addhost to add an address without prompting. Typically // this is only done for the localhost. When you get a new peer name // off the network, use queryhost to see if it is already in the list // and if not, prompt the user to see if a connection should be allowed. // // 1999-Feb-21 - [AFT] //--- #import "hostobj.h" #import #import #import #import @implementation hostobj - initwithdispatch:(id)adispatch { mydispatch = adispatch; hostlist = [Storage newCount:0 elementSize:4 description:"[i]"]; hostmenu = [[NSMenu alloc] initWithTitle:[NSString stringWithCString:"Hosts"]]; [hostmenu sizeToFit]; return self; } - (NSMenu *) gethostmenu { return hostmenu;; } - (void) addhost:(int)iaddr { struct hostent *host; struct in_addr addr; // Add to list of approved addresses [hostlist addElement:(void *)&iaddr]; // Get actual machine name and add to hosts submenu. addr.s_addr = iaddr; host = gethostbyaddr((char *)&addr, sizeof(addr), AF_INET); [[hostmenu addItemWithTitle:[NSString stringWithCString:host->h_name] action:@selector(removehost:) keyEquivalent:@""] setTarget:mydispatch]; [hostmenu sizeToFit]; return; } - (BOOL) queryhost:(int)isuspect { struct hostent *host; struct in_addr addr; char cbuf[128]; int *ihost; int i, iresult, ltmp, nhost; // If the suspect IP address is in the approved list, then return true. nhost=[hostlist count]; for(i=0; ih_name); memcpy(&cbuf, host->h_name, ltmp); cbuf[ltmp]='\0'; // And prompt user to see if this is OK. iresult = NSRunAlertPanel(@"pgview: Accept connection from", [NSString stringWithCString:cbuf], @"Accept",@"Reject",nil); // If it is OK, then add to list of approved hosts. if ( iresult ) [self addhost:isuspect]; return iresult; } - (void) removehost:(NSMenuItem *) sender { struct hostent *ahost; char cbuf[128]; int *ihost; int i, iresult, isuspect, nhost; // Come here if the user has selected a host from the hosts submenu. // The menuItem title conveniently contains the host name. [[sender title] getCString:cbuf maxLength:128]; ahost = gethostbyname(cbuf); if (ahost == 0) { fprintf(stderr, "%s: unknown host", cbuf); } else { // We now have the host IP address. Find entry in hostlist. memcpy(&isuspect, ahost->h_addr, 4); nhost=[hostlist count]; for(i=0; ih_name] action:@selector(removehost:) keyEquivalent:@""] setTarget:mydispatch]; [hostmenu sizeToFit]; return; } - (BOOL) queryhost:(int)isuspect { struct hostent *host; struct in_addr addr; char cbupgplot/sys_openstep/pgview/ipanelobj.h010064400040640000322000000001160666455646200207230ustar00tjpcitmbr00000400000017#import @interface ipanelobj : NSView { } - showit; @end pgplot/sys_openstep/pgview/ipanelobj.m010064400040640000322000000024750666512037100207250ustar00tjpcitmbr00000400000017// ipanel creates and displays the pgview info panel. // // 1999-Feb-20 - [AFT] //--- #import "ipanelobj.h" @implementation ipanelobj - showit { static NSRect aRect = {{160.0, 500.0},{330.0,120.0}}; NSWindow *aPanel; aPanel = [[NSWindow alloc] initWithContentRect:aRect styleMask:NSTitledWindowMask|NSClosableWindowMask backing:NSBackingStoreBuffered defer:NO]; [aPanel setContentView:self]; [aPanel setBackgroundColor:[NSColor whiteColor]]; [aPanel setReleasedWhenClosed:YES]; [aPanel setTitle:@"Info"]; [aPanel display]; [aPanel orderFront:self]; return self; } - (void)drawRect:(NSRect)rects { NSImage *myicon; static NSPoint iloc = {20.0, 45.0}; PSmoveto(100.0, 80.0); PSselectfont("Times-Roman",24.0); PSshow("PGPLOT Viewer"); PSmoveto(120.0, 50.0); PSselectfont("Times-Roman",16.0); PSshow("by Allyn Tennant"); PSsetgray(0.25); PSmoveto(20.0, 9.0); PSselectfont("Times-Roman",10.0); PSshow("1999-Feb-20 X-ray Astronomy Group, Marshall Space Flight Center"); PSmoveto(0.0, 25.0); PSlineto(350.0, 25.0); PSstroke(); myicon=[NSApp applicationIconImage]; [myicon compositeToPoint:iloc operation:NSCompositeSourceOver]; return; } @end pgplot/sys_openstep/pgview/makef010064400040640000322000000005320666455745700176240ustar00tjpcitmbr00000400000017ICONSECTIONS = -sectcreate __ICON app pgicon.tiff pgview: pgview.o portobj.o dispatchobj.o pgviewobj.o ipanel.o hostobj.o cc -o pgview pgview.o portobj.o dispatchobj.o \ pgviewobj.o ipanel.o hostobj.o\ -framework AppKit -framework Foundation $(ICONSECTIONS) demo: demo.o nexsup.o cc -o demo demo.o nexsup.o clean: rm -f demo pgview *.o pgplot/sys_openstep/pgview/nexsup.c010064400040640000322000000143750666502764500203060ustar00tjpcitmbr00000400000017/* nexsup.c--This is a 'support routine' used by the nedriv.f code, */ /* In brief, this is the main interface between the Fortran and */ /* C languages. It is called from Fortran and uses a UNIX socket */ /* to send messages to the PGPLOT viewer. */ /* 199-Feb-24 - update from nexsup.m - [AFT] */ #include #include #include #include #include #include int pgsock=-1; struct sockaddr_in server; #ifdef __STDC__ void grgetreply(int ifunc,int *ibuf,int *lbuf) #else void grgetreply(ifunc, ibuf, lbuf) int ifunc; int *ibuf; int *lbuf; #endif { /* Used by nexsup to send a message over the socket and wait */ /* for a reply back */ struct sockaddr_in replyadd; struct pgmess { unsigned char c1func; unsigned char c1len; char cmess[256]; }; struct pgmess sbuf; int msgsock, repsock; int i, itmp; /* We need a socket that pgview can reply to. Create descriptor. */ repsock = socket(AF_INET, SOCK_STREAM, 0); if (repsock < 0) { perror("opening stream socket"); exit(1); } /* Name socket using wildcards */ replyadd.sin_family = AF_INET; replyadd.sin_addr.s_addr = INADDR_ANY; replyadd.sin_port = 0; if (bind(repsock, (struct sockaddr *)&replyadd, sizeof(replyadd))) { perror("binding stream socket"); exit(1); } /* Find out assigned port number so we can forward to the server. */ itmp = sizeof(replyadd); if (getsockname(repsock, (struct sockaddr *)&replyadd, &itmp)) { perror("getting socket name"); exit(1); } /* Start accepting connections */ listen(repsock, 5); /* Now tell pgview the port that we are listen'ing on. Note, the port */ /* number is already in network byte order which is what pgview needs. */ sbuf.c1func = ifunc; sbuf.c1len = 2; memcpy(sbuf.cmess, &replyadd.sin_port, 2); if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); /* Now wait for the reply */ msgsock = accept(repsock, (struct sockaddr *)0, (int *)0); if (msgsock == -1) perror("accept"); else { *lbuf = read(msgsock, ibuf, 16); } close(msgsock); return; } #ifdef __STDC__ void nexsup_(int *ifunc, char *cbuf, float rtmp[], int len_cbuf) #else void nexsup_(ifunc, cbuf, rtmp, len_cbuf) int *ifunc; char *cbuf; float rtmp[]; int len_cbuf; #endif { struct hostent *hp; struct pgmess { unsigned char c1func; unsigned char c1len; char cmess[256]; }; struct pgmess sbuf; char *cdis, *cview; char cloc[256]; int ibuf[10]; int i, icnt, itmp, lbuf, lloc; if ( pgsock<0 ) { icnt = 0; do { /* Create socket descriptor. */ pgsock = socket(AF_INET, SOCK_STREAM, 0); if ( pgsock < 0) { perror("opening stream socket"); } /* Create socket address structure */ server.sin_family = AF_INET; cdis = (char *) getenv("DISPLAY"); if ( cdis==NULL ) cdis="localhost"; else { /* Convert a colon to null (end of string) */ for (i=0; ih_addr, hp->h_length); server.sin_port = htons(7974); /* Connect descriptor to address */ itmp=connect(pgsock,(struct sockaddr *)&server,sizeof(server)); if ( itmp<0 ) { close(pgsock); if ( icnt==0 ) { cview = (char *) getenv("PGVIEW"); if ( cdis==NULL || cview!=NULL ) { /* If PGVIEW is defined or DISPLAY is not defined, then try to launch pgview */ printf("Launching pgview...\n"); if ( cview==NULL ) cview="/LocalApps/pgview.app/pgview"; strcpy(cloc, cview); lloc=strlen(cloc); cloc[lloc]=' '; cloc[lloc+1]='&'; cloc[lloc+2]='\0'; system(cloc); } else { printf("Please launch pgview on your display system.\n"); } } sleep(1); if((icnt/5)*5 == icnt) printf("waiting...\n"); icnt=icnt+1; } } while (itmp<0 && icnt<20); if ( itmp < 0 ) { printf("Could not find port connected to pgview.\n"); exit(1); } } switch (*ifunc) { case 1: grgetreply(1, ibuf, &lbuf); rtmp[0]=(float)ntohl(ibuf[0]); rtmp[1]=(float)ntohl(ibuf[1]); rtmp[2]=(float)ntohl(ibuf[2]); rtmp[3]=(float)ntohl(ibuf[3]); break; case 2: sbuf.c1func = 2; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 3: /* Make sure we send the null character at the end. */ itmp=strlen(cbuf)+1; sbuf.c1func = 3; sbuf.c1len = itmp; memcpy(sbuf.cmess, cbuf, itmp); if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 4: grgetreply(4, ibuf, &lbuf); rtmp[0]=(float)ntohl(ibuf[0]); rtmp[1]=(float)ntohl(ibuf[1]); rtmp[2]=(float)ntohl(ibuf[2]); break; case 5: sbuf.c1func = 5; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 6: sbuf.c1func = 6; sbuf.c1len = 0; if (write(pgsock, &sbuf, sbuf.c1len+2) < 0) perror("writing on stream socket"); break; case 7: close(pgsock); pgsock=-1; break; default : printf("nexsup--Unknown function code= %d\n",*ifunc); break; } } uf, 16); } close(msgsock); return; } #ifdef __STDC__ void nexsup_(int *ifunc, char *cbuf, float rtmp[], int len_cbuf) #else void nexsup_(ifunc, cbuf, rtmp, len_cbuf) int *ifunc; char *cbuf; float rtmp[]; int len_cbupgplot/sys_openstep/pgview/pgicon.tiff010064400040640000322000000223020666340406400207260ustar00tjpcitmbr00000400000017II*$ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿ ÿÿ ÿ ÿ ÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿ ÿÿ ÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ 00ª$$²$º$(R€ü '€ü 'ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ ÿ ÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿpgplot/sys_openstep/pgview/pgview.iconheader010064400040640000322000000000540666526624200221270ustar00tjpcitmbr00000400000017F pgview.app pgview app F pgview pgview app pgplot/sys_openstep/pgview/pgview_main.m010064400040640000322000000056550666701160200212700ustar00tjpcitmbr00000400000017#import #import #import "portobj.h" #import "dispatchobj.h" #include void main(int argc, char *argv[]) { portobj *myport; dispatchobj *mydispatch; NSAutoreleasePool *pool; NSConnection *conn; NSMenu *mymenu, *newmenu; NSMenuItem *hitem, *nitem; unsigned short iport=7974; /* Black magic to make everything work */ [NSApplication sharedApplication]; pool = [[NSAutoreleasePool alloc] init]; /* Create a dispatch object */ mydispatch = [[dispatchobj alloc] init]; /* Create the port object */ myport = [[portobj alloc] initport:iport target:mydispatch]; /* Black magic to get sockets to work. */ conn = [NSConnection connectionWithReceivePort:myport sendPort:myport]; if (conn == nil) { NSLog(@"couldn't create a connection!"); [pool release]; exit(1); } [conn setRootObject:mydispatch]; /* Create the "new" submenu */ newmenu = [[NSMenu alloc] initWithTitle:[NSString stringWithCString:"New"]]; [[newmenu addItemWithTitle:[NSString stringWithCString:"Landscape"] action:@selector(newLand) keyEquivalent:[NSString stringWithCString:"L"]] setTarget:mydispatch]; [[newmenu addItemWithTitle:[NSString stringWithCString:"Portrait"] action:@selector(newPort) keyEquivalent:[NSString stringWithCString:"O"]] setTarget:mydispatch]; /* Create the menu */ mymenu = [[NSMenu alloc] initWithTitle:[NSString stringWithCString:"pgview"]]; [[mymenu addItemWithTitle:[NSString stringWithCString:"Info..."] action:@selector(showInfo) keyEquivalent:@""] setTarget:mydispatch]; nitem=[mymenu addItemWithTitle:[NSString stringWithCString:"New"] action:NULL keyEquivalent:@""]; [mymenu setSubmenu:newmenu forItem:nitem]; hitem=[mymenu addItemWithTitle:[NSString stringWithCString:"Hosts"] action:NULL keyEquivalent:@""]; [mymenu setSubmenu:[myport gethostmenu] forItem:hitem]; [[mymenu addItemWithTitle:[NSString stringWithCString:"Print"] action:@selector(pgprint) keyEquivalent:[NSString stringWithCString:"p"]] setTarget:mydispatch]; [[mymenu addItemWithTitle:[NSString stringWithCString:"Deactivate"] action:@selector(deactive) keyEquivalent:[NSString stringWithCString:"d"]] setTarget:mydispatch]; [mymenu addItemWithTitle:[NSString stringWithCString:"Hide"] action:@selector(hide:) keyEquivalent:[NSString stringWithCString:"h"]]; [mymenu addItemWithTitle:[NSString stringWithCString:"Quit"] action:@selector(terminate:) keyEquivalent:[NSString stringWithCString:"q"]]; [mymenu sizeToFit]; [NSApp setMainMenu:mymenu]; [NSApp run]; [pool release]; exit(0); } pgplot/sys_openstep/pgview/pgviewobj.h010064400040640000322000000012260666663112100207430ustar00tjpcitmbr00000400000017#import #import @interface pgviewobj : NSView { Storage *psdata; NSWindow *myWindow; float prevw, prevh; int lwtype; int nplot; } - initWithFrame:(NSRect)frameRect; - (void) drawRect:(NSRect)rects; - (void) pgplotDefs: (DPSContext) ctxt; - (void) beginp; - (void) endp; - (void) flushpg; - (void) gettype: (int *) iptype; - (void) getwind: (int *) ixdim by: (int *) iydim color: (int *) icol scale: (int *) imag; - (void) pscode: (char *) cbuf; - (void) readcursor: (NSPoint *) aPoint char: (int *) ichar cursor: (NSCursor *) crossCursor; @end pgplot/sys_openstep/pgview/pgviewobj.m010064400040640000322000000174160666663115400207660ustar00tjpcitmbr00000400000017// pgviewobj.m is the custom view object for the pgview program. PGView // receives 132 byte character arrays filled with PostScript code. PGView // saves these buffers in a Storage object. When the PGPLOT program // executes a flushpg operation, this stored data is then sent to the // display. // // 1999-Feb-20 - Update for OpenStep - [AFT] // 1992-Mar-09 - [AFT] //--- #import "pgviewobj.h" @implementation pgviewobj - initWithFrame:(NSRect)frameRect { [super initWithFrame:frameRect]; // Create an enclosing window and bring it upfront myWindow = [[NSWindow alloc] initWithContentRect:frameRect styleMask:NSResizableWindowMask| (NSMiniaturizableWindowMask | NSClosableWindowMask) backing:NSBackingStoreBuffered defer:NO]; [myWindow setContentView:self]; [myWindow setBackgroundColor:[NSColor whiteColor]]; [myWindow setReleasedWhenClosed:YES]; [myWindow setTitle:@"PGPLOT Viewer"]; [myWindow display]; [myWindow orderFront:self]; // Save portrait/landscape flag if( frameRect.size.width > frameRect.size.height) { lwtype=0; } else { lwtype=1; } // Needed to do PostScript scaling [self scaleUnitSquareToSize:NSMakeSize(0.1, 0.1)]; prevw = [self bounds].size.width; prevh = [self bounds].size.height; // PostScript data sent from PGPLOT will be stored in psdata. psdata = [Storage newCount:0 elementSize:132 description:"[132c]"]; nplot=0; // Allocate private graphics state, so things like the current color // setting will be preserved between different calls to drawSelf. [self allocateGState]; return self; } - (void)drawRect:(NSRect)rect { DPSContext ctxt; NSRect bounds; int i; if ( nplot > 0) { bounds=[self bounds]; if( prevw != bounds.size.width || prevh != bounds.size.height) { [self scaleUnitSquareToSize:NSMakeSize(bounds.size.width/prevw, bounds.size.height/prevh)]; prevw = bounds.size.width; prevh = bounds.size.height; } ctxt= DPSGetCurrentContext(); for(i=0; i nplot) { [self lockFocus]; ibeg=nplot; nplot = [psdata count]; ctxt= DPSGetCurrentContext(); for(i=ibeg; i #import "dispatchobj.h" #import "hostobj.h" @interface portobj : NSPort { id portFile; // the connect()ed NSFileHandle dispatchobj *mydispatch; hostobj *hostlist; int mypeer; int istate; int ifunc; int ilen; int nread; char cbuf[256]; } - (portobj *)initport:(unsigned short)ipn target:(dispatchobj *)adispatch; - (NSMenu *) gethostmenu; @end pgplot/sys_openstep/pgview/portobj.m010064400040640000322000000222160666554705600204510ustar00tjpcitmbr00000400000017// portobj.m--This creates a NSPort object that can be used in a // NSConnection. Since we are using Unix/Internet stream sockets // and not Mach sockets, most methods need to be overwritten. // based on /NextDeveloper/Examples/Foundation/TCPTransport/TCPPort.m // 1999-Feb-22 - [AFT] #import "portobj.h" #import #import #import #import #define INVALID_SOCKET -1 #if !defined(__svr4__) && !defined(WIN32) #import #endif @implementation portobj // //--- Useful function // void grreply(int peeraddr, short iport, void *reply, int lreply) { struct sockaddr_in repadd; int repsock; // Create reply socket descriptor repsock = socket(AF_INET, SOCK_STREAM, 0); // Create the reply address structure memset((char *)&repadd, 0, sizeof(struct sockaddr_in)); repadd.sin_family = AF_INET; repadd.sin_port=iport; repadd.sin_addr.s_addr = peeraddr; if (connect(repsock, (struct sockaddr *)&repadd, sizeof(repadd)) < 0) { perror("connecting reply socket"); } else { if (write(repsock, reply, lreply) < 0) perror("writing on stream socket"); } close(repsock); return; } // //--- Class methods ----------------------------------------------------- // - (portobj *)initport:(unsigned short)ipn target:(dispatchobj *)adispatch { NSHost *myhost; struct sockaddr_in addr; struct hostent *ahost; char *ctmp; int fd; int itmp, ltmp; // Create socket descriptor fd = socket(PF_INET, SOCK_STREAM, 0); if (fd == INVALID_SOCKET) { NSLog(@"socket call failed"); return nil; } // Create the address structure ltmp = sizeof(struct sockaddr_in); memset((char *)&addr, 0, ltmp); addr.sin_family = AF_INET; addr.sin_addr.s_addr = INADDR_ANY; addr.sin_port = htons(ipn); // Bind address structure to socket descriptor if (bind(fd, (struct sockaddr *)&addr, ltmp) < 0) { NSLog(@"bind failed"); close(fd); return nil; } // Passively listen for connections. listen(fd, 5); // Create an NSFileHandle object to do the waiting portFile = [[NSFileHandle alloc] initWithFileDescriptor:fd]; mydispatch = adispatch; // This tells portFile to alert us for connection attempts. [[NSNotificationCenter defaultCenter] addObserver:self selector:@selector(acceptNotification:) name:NSFileHandleConnectionAcceptedNotification object:portFile]; // Create the hostobj to manage the list of hosts that are allowed // to connect to us. hostlist=[hostobj new]; [hostlist initwithdispatch:self]; // Add "localhost" to list. ctmp="localhost"; ahost = gethostbyname(ctmp); if (ahost == 0) { fprintf(stderr, "%s: unknown host", ctmp); } else { memcpy(&itmp, ahost->h_addr, 4); [hostlist addhost:itmp]; } // Get the actual IP address of local machine and add. myhost = [NSHost currentHost]; if ( myhost != nil ) { itmp = inet_addr([[myhost address] cString]); [hostlist addhost:itmp]; } return self; } - (NSMenu *) gethostmenu { return [hostlist gethostmenu]; } - (void) removehost:(id) sender { [hostlist removehost:sender]; return; } // //--- methods needed by runloop ----------------------------------------- // - (void)addConnection:(NSConnection *)conn toRunLoop:(NSRunLoop *)runLoop forMode:(NSString *)mode { portobj *listener = [conn receivePort]; portobj *sender = [conn sendPort]; [listener->portFile acceptConnectionInBackgroundAndNotify]; if (listener != sender) { [sender->portFile readInBackgroundAndNotify]; } return; } - (void)removeConnection:(NSConnection *)conn fromRunLoop:(NSRunLoop *)runLoop forMode:(NSString *)mode { // Since addConnection allocates no objects, we have none to release. } - (void)acceptNotification:(NSNotification *)note { NSFileHandle *msgFile; NSConnection *connection; portobj *sp; struct sockaddr_in peeradd; int msgsock, itmp; // Get the file handle info for the incoming messages msgFile = [[note userInfo] objectForKey:NSFileHandleNotificationFileHandleItem]; // We now have all data from the Notification. Allow another connection. [portFile acceptConnectionInBackgroundAndNotify]; if (!msgFile) { NSLog(@"** no socket in notification info %@", [note userInfo]); return; } // Find out who is trying to connect with us. msgsock=[msgFile fileDescriptor]; itmp = sizeof(peeradd); if (getpeername(msgsock, (struct sockaddr *)&peeradd, &itmp)) { perror("getting socket name"); } if ( ![hostlist queryhost:peeradd.sin_addr.s_addr] ) { // User rejected the connection, close the file handle. [msgFile closeFile]; return; } // Create a port to receive the messages. This will be a "sendPort". sp = [isa alloc]; if (!sp) { return; } // This tells the msgFile handle to stick around and saves the pointer // in our local portFile variable. sp->portFile = [msgFile retain]; sp->mydispatch = mydispatch; sp->mypeer=peeradd.sin_addr.s_addr; sp->istate = 0; [sp autorelease]; [[NSNotificationCenter defaultCenter] addObserver:sp selector:@selector(readNotification:) name:NSFileHandleReadCompletionNotification object:msgFile]; connection = [[NSConnection alloc] initWithReceivePort:self sendPort:sp]; return; } - (void) sendoff { // We have now read the function code, length, and data. Dispatch. short iport; float r1, r2; int ibuf[4], itmp[4]; int i; switch (ifunc) { case 1: memcpy(&iport, cbuf, 2); [mydispatch getwind:&itmp[0] by:&itmp[1] color:&itmp[3] scale:&itmp[2]]; for (i=0; i<4; i++) { ibuf[i]=htonl(itmp[i]); } grreply(mypeer, iport, &ibuf, 16); break; case 2: [mydispatch beginp]; break; case 3: [mydispatch pscode:cbuf]; break; case 4: memcpy(&iport, cbuf, 2); [mydispatch cursorat:&r1 and:&r2 char:&itmp[2]]; ibuf[0] = htonl( (int) r1 ); ibuf[1] = htonl( (int) r2 ); ibuf[2] = htonl( itmp[2] ); grreply(mypeer, iport, &ibuf, 12); break; case 5: [mydispatch flushpg]; break; case 6: [mydispatch endp]; break; default: printf("portobj--Unknown function code= %d\n",ifunc); break; } /* end switch (ifunc) */ } - (void)readNotification:(NSNotification *)note { NSData *data; NSRange substring; int lentot, ioff; unsigned char c1buf; data = [[note userInfo] objectForKey:NSFileHandleNotificationDataItem]; lentot=[data length]; if ( lentot<0 ) { perror("reading stream message"); return; } else if (lentot == 0) { // Nothing more to read. Close file handle and exit. [portFile closeFile]; return; } // Set the next read going. [portFile readInBackgroundAndNotify]; ioff=0; do { switch (istate) { case 0: // Read function code nread = 0; substring.location=ioff; substring.length=1; [data getBytes:&c1buf range:substring]; ioff=ioff+substring.length; ifunc=c1buf; istate = 1; break; case 1: // Read length substring.location=ioff; substring.length=1; [data getBytes:&c1buf range:substring]; ioff=ioff+substring.length; ilen=c1buf; if ( ilen==0 ) { // No data package to read, dispatch now. istate = 0; //printf("ifunc=%i, ilen=%i\n",ifunc,ilen); [self sendoff]; } else { // Next read the data. istate = 2; } break; case 2: // Read data. There are two input cases, either cbuf is empty or // it contains part of a previous read. Both cases are handled // by starting cbuf at position nread. Likewise there are two output // cases, either we finish the read or we don't. substring.location=ioff; if ( ilen-nread <= lentot-ioff ) { // Can finish the read. State will change. substring.length = ilen-nread; istate = 0; } else { // Incomplete read, so no state change. substring.length = lentot-ioff; } [data getBytes:&cbuf[nread] range:substring]; ioff=ioff+substring.length; nread = nread+substring.length; if ( istate==0 ) { //printf("ifunc=%i, ilen=%i\n",ifunc,ilen); [self sendoff]; } } /* end switch (state) */ } while ( ioff", [portFile fileDescriptor]]; //} @end pgplot/sys_openstep/f2c_src/iand.c010064400040640000322000000002200567152654300176740ustar00tjpcitmbr00000400000017int iand_ (a,b) int *a; int *b; { static int res; res = (*a & *b); /* printf ("iand result: %d\n",res); */ return (res); } pgplot/sys_openstep/f2c_src/nfc010075500040640000322000000064610665612362100173200ustar00tjpcitmbr00000400000017#!/bin/sh PATH=/bin:/usr/bin:/usr/local/bin # f77-style shell script to compile and load fortran, C, and assembly codes # usage: f77 [options] files [-l library] # Options: # -o objfile Override default executable name a.out. # -c Do not call linker, leave relocatables in *.o. # -C Check that subscripts are in bounds. # -S leave assembler output on file.s # -l library (passed to ld). # -u complain about undeclared variables # -w omit all warning messages # -w66 omit Fortran 66 compatibility warning messages # files FORTRAN source files ending in .f . # C source files ending in .c . # Assembly language files ending in .s . # efl source files ending in .e . # -D def passed to C compiler (for .c files) # -I includepath passed to C compiler (for .c files) # -Ntnnn allow nnn entries in table t s=/tmp/stderr_$$ t=/tmp/f77_$$.o CC=${CC_f2c:-/bin/cc} CFLAGS="$CFLAGS -I/usr/local/include" EFL=${EFL:-efl} EFLFLAGS=${EFLFLAGS:-'system=portable deltastno=10'} RATFOR=${RATFOR:-ratfor} RFLAGS=${RFLAGS:-'-6&'} F2C=${F2C:-f2c} F2CFLAGS=${F2CFLAGS:='-ARw8 -Nn802'} rc=0 trap "rm -f $s $t; exit \$rc" 0 lib=/lib/num/lib.lo OUTF=a.out cOPT=1 CCFLAGS=-DINLINE_MATH CPPFLAGS= while test -n "$1" do case "$1" in -!bs) F2CFLAGS="$F2CFLAGS -!bs" shift ;; -C) F2CFLAGS="$F2CFLAGS -C" shift;; -c) cOPT=0 shift ;; -D) CCFLAGS="$CCFLAGS -D$2" shift 2 ;; -g) CFLAGS="$CFLAGS -g" CCFLAGS="$CCFLAGS -g" F2CFLAGS="$F2CFLAGS -g" shift;; -I) CCFLAGS="$CCFLAGS -I$2" shift 2 ;; -o) OUTF=$2 shift 2 ;; -O) CFLAGS="$CFLAGS -O -DINLINE_MATH" shift;; -u) F2CFLAGS="$F2CFLAGS -u" shift ;; -w) F2CFLAGS="$F2CFLAGS -w" case $2 in -6) F2CFLAGS="$F2CFLAGS"66; shift case $2 in -6) shift;; esac;; esac shift ;; -N) F2CFLAGS="$F2CFLAGS $1""$2" shift 2 ;; -S) CFLAGS="$CFLAGS -S" cOPT=0 shift ;; # *.[fF]) case "$1" in *.f) f=".f";; *.F) f=".F";; esac b=`basename $1 $f` $F2C $F2CFLAGS $1 case $? in 0);; *) exit;; esac $CC -c $CFLAGS $b.c 2>$s rc=$? sed '/parameter .* is not referenced/d;/warning: too many parameters/d' $s 1>&2 case $rc in 0);; *) exit;; esac OFILES="$OFILES $b.o" rm $b.c case $cOPT in 1) cOPT=2;; esac shift ;; *.e) b=`basename $1 .e` $EFL $EFLFLAGS $1 >$b.f case $? in 0);; *) exit;; esac $F2C $F2CFLAGS $b.f case $? in 0);; *) exit;; esac $CC -c $CFLAGS $b.c case $? in 0);; *) exit;; esac OFILES="$OFILES $b.o" rm $b.[cf] case $cOPT in 1) cOPT=2;; esac shift ;; *.s) echo $1: 1>&2 OFILE=`basename $1 .s`.o ${AS:-/usr/bin/as} -o $OFILE $AFLAGS $1 case $? in 0);; *) exit;; esac OFILES="$OFILES $OFILE" case $cOPT in 1) cOPT=2;; esac shift ;; *.c) echo $1: 1>&2 OFILE=`basename $1 .c`.o $CC -c $CFLAGS $CCFLAGS $1 rc=$?; case $rc in 0);; *) exit;; esac OFILES="$OFILES $OFILE" case $cOPT in 1) cOPT=2;; esac shift ;; *.o) OFILES="$OFILES $1" case $cOPT in 1) cOPT=2;; esac shift ;; -l) OFILES="$OFILES -l$2" shift 2 case $cOPT in 1) cOPT=2;; esac ;; -l*) OFILES="$OFILES $1" shift case $cOPT in 1) cOPT=2;; esac ;; -o) OUTF=$2; shift 2;; *) OFILES="$OFILES $1" shift case $cOPT in 1) cOPT=2;; esac ;; esac done case $cOPT in 2) $CC -o $OUTF -u _MAIN__ $OFILES -lf2c -lm;; esac rc=$? exit $rc pgplot/sys_openstep/f2c_src/grgenv.c010064400040640000322000000050330567207245000202520ustar00tjpcitmbr00000400000017#include #include /* **GRGENV -- get value of PGPLOT environment parameter (Cray) *+ * SUBROUTINE GRGENV(NAME, VALUE, L) * CHARACTER*(*) NAME, VALUE * INTEGER L * * Return the value of a PGPLOT environment parameter. In Sun/Convex-UNIX, * environment parameters are UNIX environment variables; e.g. parameter * ENVOPT is environment variable PGPLOT_ENVOPT. Translation is not * recursive and is case-sensitive. * * Arguments: * NAME : (input) the name of the parameter to evaluate. * VALUE : receives the value of the parameter, truncated or extended * with blanks as necessary. If the parameter is undefined, * a blank string is returned. * L : receives the number of characters in VALUE, excluding * trailing blanks. If the parameter is undefined, zero is * returned. *-- * 13-Nov-1994 - [mcs] f2c callable C version for NeXT. *----------------------------------------------------------------------- */ void grgenv_(name, value, length, name_dim, value_dim) char *name, *value; int *length; int name_dim, value_dim; { static char *prefix = "PGPLOT_"; /* Environment variable name prefix */ char test[33]; /* PGPLOT_* Concatenation buffer */ int name_len; /* Un-padded length of 'name' string */ int prefix_len; /* The length of prefix[] */ char *env=0; /* Environment variable value */ int i; /* * Determine the length of 'name' by searching for the last * non-space character. */ name_len = name_dim; while(name_len > 0 && name[name_len-1] == ' ') name_len--; /* * Determine the length of the prefix. */ prefix_len = strlen(prefix); /* * Prefix 'name' with PGPLOT_ if there is room in test[]. */ if(prefix_len + name_len + 1 <= sizeof(test)/sizeof(char)) { strcpy(test, prefix); strncpy(&test[prefix_len], name, name_len); test[prefix_len+name_len] = '\0'; /* * Get the value of the environment variable now named in test[]. */ env = getenv(test); }; /* * Substitute an empty string if no value was obtained, or the value * obtained is too long to fit in the output string. */ if(env==0 || strlen(env) > value_dim) env = ""; /* * Copy the environment variable value into the output string. */ strncpy(value, env, value_dim); /* * Return the unpadded length of the string. */ { int env_len = strlen(env); *length = (env_len <= value_dim) ? env_len : value_dim; }; /* * Pad the fortran string with spaces. */ for(i = *length; i long int groter_(cdev, ldev, cdev_len) char *cdev; long int *ldev; int cdev_len; /* Open a channel to the device specified by 'cdev'. * * cdev I The name of the device to be opened * ldev I Number of valid characters in cdev * cdev_len I Used by Fortran compiler to pass character length * groter O The open channel number (-1 indicates an error) */ { int fd, n; char name[64]; n = *ldev; if (n > 63) n = 63; strncpy(name, cdev, n); name[n] = '\0'; if ((fd = open(name, 2)) == -1) { /* perror("Cannot access graphics device"); */ perror(name); return -1; } else { return fd; } } grcter_(fd) int *fd; /* Close a previously opened channel. * * fd I The channel number to be closed */ { close(*fd); } grwter_(fd, cbuf, lbuf, cbuf_len) int *fd; char *cbuf; long int *lbuf; int cbuf_len; /* Write lbuf bytes from cbuf to the channel fd. Data is written in * CBREAK mode. * * fd I The channel number * cbuf I Character array of data to be written * lbuf I/O The number of bytes to write, set to zero on return * cbuf_len I Used by Fortran compiler to pass character length */ { int nwritten; struct sgttyb tty; int save_flags; /* printf ("writing %d bytes on unit %d\n", *lbuf, *fd); */ ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; nwritten = write (*fd, cbuf, *lbuf); ioctl(*fd, TIOCSETP, &tty); if (nwritten != *lbuf) perror("Error writing to graphics device"); *lbuf = 0; return; } grpter_(fd, cprom, lprom, cbuf, lbuf, cprom_len, cbuf_len) int *fd; char *cprom, *cbuf; long int *lprom, *lbuf; int cprom_len, cbuf_len; /* Write prompt string on terminal and then read response. This version * will try to read lbuf characters. * * fd I The channel number * cprom I An optional prompt string * lprom I Number of valid characters in cprom * cbuf O Character array of data read * lbuf I/O The number of bytes to read, on return number read * cbuf_len I Used by Fortran compiler to pass character length */ { int i0, nread, ntry; struct sgttyb tty; int save_flags; ioctl(*fd, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags |= CBREAK; ioctl(*fd, TIOCSETP, &tty); tty.sg_flags = save_flags; if( *lprom>0) write (*fd, cprom, *lprom); i0=0; ntry=*lbuf; do { nread = read (*fd, &cbuf[i0], ntry); /* printf("Nread=%d, Ntry=%d\n",nread,ntry); */ i0=i0+nread; ntry=*lbuf-i0-1; } while (nread>0 && ntry>0); ioctl(*fd, TIOCSETP, &tty); *lbuf=i0; return; } s character length * groter O The open channel nupgplot/sys_openstep/f2c_src/grgetc.c010064400040640000322000000053600567152654400202470ustar00tjpcitmbr00000400000017/* Read one character from terminal, interpreting VT100/VT200 escape sequences. The program reads from standard input. */ /* To put the terminal into 'keypad application mode' send ESC =; to reset, send ESC > */ /* DEC keyboards generate the following escape sequences. CSI is either the single character 0x9B or the two characters ESC (0x1B) [ (0x5B). SS3 is the character 0x8F or the two characters ESC (0x1B) O (0x4F). Key Code generated Value returned by GRGETC Up arrow CSI A, SS3 A -1 Down arrow CSI B, SS3 B -2 Right arrow CSI C, SS3 C -3 Left arrow CSI D, SS3 D -4 Keypad 0 SS3 p -20 1 SS3 q -21 2 SS3 r -22 3 SS3 s -23 4 SS3 t -24 5 SS3 u -25 6 SS3 v -26 7 SS3 w -27 8 SS3 x -28 9 SS3 y -29 - SS3 m -17 , SS3 l -16 . SS3 n -18 Enter SS3 M -8 PF1 SS3 P -11 PF2 SS3 Q -12 PF3 SS3 R -13 PF4 SS3 S -14 The following are not implemented yet: Find CSI 1 ~ Insert here CSI 2 ~ Remove CSI 3 ~ Select CSI 4 ~ Prev Screen CSI 5 ~ Next Screen CSI 6 ~ F6 CSI 1 7 ~ F7 CSI 1 8 ~ F8 CSI 1 9 ~ F9 CSI 2 0 ~ F10 CSI 2 1 ~ F11 CSI 2 3 ~ F12 CSI 2 4 ~ F13 CSI 2 5 ~ F14 CSI 2 6 ~ Help CSI 2 8 ~ Do CSI 2 9 ~ F17 CSI 3 1 ~ F18 CSI 3 2 ~ F19 CSI 3 3 ~ F20 CSI 3 4 ~ */ #include #include #define CSI (0x9B) #define SS3 (0x8F) #define ESC (0x1B) grgetc_(val) int *val; { static char valid_table[] = { 'A','B','C','D', 'P','Q','R','S', 'p','q','r','s','t','u','v','w','x','y', 'm','l','n', 'M' }; static short code_table[] = { -1,-2,-3,-4, -11,-12,-13,-14, -20,-21,-22,-23,-24,-25,-26,-27,-28,-29, -17,-16,-18, -8 }; static struct sgttyb tty; int tmp=0, i; int nextch; static int init=1; static int raw=0; static int save_flags; if (init) { putchar(ESC); putchar('='); init = 0; } if (raw == 0) { ioctl(0, TIOCGETP, &tty); save_flags = tty.sg_flags; tty.sg_flags = CBREAK; ioctl(0, TIOCSETP, &tty); raw = 1; } ioctl(0, TIOCFLUSH,&tmp); nextch = getchar(); if (nextch == ESC) { nextch = getchar(); if (nextch == '[') nextch = CSI; if (nextch == 'O') nextch = SS3; } if (nextch == CSI || nextch == SS3) { nextch = getchar(); for (i=0; i<22; i++) if (valid_table[i] == nextch) { nextch = code_table[i]; break; } } *val = nextch; /* If a special character was received, stay in CBREAK mode; this is OK for PGPLOT cursor control, but may not be for other applications */ if (nextch >= 0) { tty.sg_flags = save_flags; ioctl(0, TIOCSETP, &tty); raw = 0; } return; } pgplot/sys_openstep/f2c_cc.conf010064400040640000322000000073440666505271200172740ustar00tjpcitmbr00000400000017# The f2c FORTRAN to C compiler and the NeXT cc compiler. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="$SYSDIR/f2c_src/nfc" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-u -!bs" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-u -!bs" # Mandatory. # The C compiler to use. CCOMPL="cc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt " # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need to append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/f2c_src" pgplot/sys_openstep/aaaread.me010064400040640000322000000172400670214647400172040ustar00tjpcitmbr00000400000017 PGPLOT on NeXT Computers Allyn F. Tennant Marshall Space Flight Center 1999-Feb-23 OVERVIEW: This directory contains an update of the Next backend needed for PGPLOT. This version has been tested only with OpenStep 4.2 for Mach on Intel hardware. In theory it should work with any OpenStep implementation, but you have been warned. The updates include: 1) The nexsup routine needed by nedriv.f no longer uses any Next specific code. It has been rewritten to use standard UNIX internet stream sockets. This has two big advantages. First, if the next driver nedriv.f is included in the pgplot library, no additional Next specific libraries are required making it easier to link PGPLOT programs that use this driver. Second, it is now possible for nedriv.f on any system, and have it send display PostScript over the network to be viewed on an OpenStep system. This does not use X Windows. 2) pgview itself no longer uses .nib files from the Interface Builder. This removes the need for any NeXT proprietary software. SUPPORTED CONFIGURATIONS: f2c_cc This intended is for people who have the Next Development and only want to install a minimal Fortran. By default the demo programs are not linked with the X11 libraries. If you wish to include an X11 driver, then you will need to edit f2c_cc.conf to add the needed libraries to the LIBS definition. g77_gcc Uses the GNU compilers. In theory, this should actually work with GNUStep the GNU implementation of OpenStep. By default the demo programs are linked with the X11 libraries. If you don't have those libraries installed then you will need to edit g77_gcc.conf to make LIBS a blank string. X WINDOWS: If you have installed an X window packate, the /XWIND and/or /XSERVE drivers compile fine on OpenStepm. If the linker complains that the setpgid is not defined in the pgxwin_server program, you should edit pgxwin_server.c and just comment out the call to setpgid(0,0). The pgxwin_server will run fine without this, although aborting the PGPLOT program, via a ^C, may also abort the server. MAKE PGPLOT: You should now refer to the standard PGPLOT documentation to create a makefile, and then compile PGPLOT. In brief you will need to create a directory where you can build PGPLOT, create a drivers.list file (make sure you include the NEXT driver!) and then use the $(PGPLOT)/makemake $(PGPLOT) openstep f2c_cc where $(PGPLOT) is the directory containing the PGPLOT source. Then type make and wait. This will create the library, demos, help files, and the pgview program. If you have asked for the XWIND driver, the pgxwin_server program should also be created. Note, the makefile will no longer create pgview. To create this program cd sys_openstep/pgview gnumake I.e., you must use the Next supplied gnumake and not make. If you wish to use make then you can try make -f makef should work. This fails to build an application directory that a user can double click on, but otherwise works fine. For best results you should install pgview.app into the /LocalApps directory. Use the following commands to do this: strip pgview.app/pgview cp -pr pgview.app /LocalApps Using 'strip' will reduce the size of the program by a factor 6 which improves startup time. ENVIRONMENT VARIABLES: PGVIEW if the viewer is not running when you select the /next then nedriv tries to open /LocalApp/pgview.app/pgview. If you have installed the viewer anywhere else, the PGVIEW should contain the full path to the pgview program itself. DISPLAY This is often set and used by X-Window based systems. nedriv.f uses DISPLAY in the same way. In brief, if DISPLAY is defined then nedriv will attempt to connect to a pgview on the machine specified. This does *not* use X-windows in any manner, I just happen to use the same environment variable. Also if the string contains a colon, it and everything following is ignored. NETWORK ACCESS: Since the interprocess communication between PGPLOT and the viewer now uses internet sockets it is no longer necessary for the PGPLOT program and the viewer to run on the same system. In fact the viewer sees all communications as coming from the network. By default. PGPLOT and pgview both connect to "localhost" which is the so called loopback. Thus if both PGPLOT and the viewer are running on the same machine, they will always be able to communicate via localhost. The viewer also figures out the name and IP address of your machine and allows access from there. In general this address is not used. It is only provided since it is functionally equivalent to using "localhost" and to allow for users who have set the DISPLAY environment variable to be the actual name of the local machine. The first time a remote system tries to connect to pgview, pgview will put up an alert panel telling you the name of the remote system and giving you a chance to either accept or reject the connection attempt. Clearly if you don't recognize the remote machine you should reject the connection. This tends to (rightfully :-) hang the remote program. Once you have allowed a connection from a machine then that name will be listed in the Hosts submenu and any program/user on that machine will be able to connect to pgview with no further prompting. All machines that can access the viewer are listed in the "Hosts" submenu found on the main pgview menu. If you click on one of the machines listed, an alert panel will pop up asking if you want to remove that system. If you click yes, then that name will be removed from the hosts submenu, and any further connection attempts from that machine will result another alert panel asking you to accept or reject the connection. For the experts, pgview listens port 7974 for connection attempts. Use of this port for other activities is discouraged. USEFUL TIPS WHEN USING PGVIEW: If the environment variable PGVIEW is defined and PGPLOT fails to connect with a server, then the PGPLOT program will *always* try running the program specified in PGVIEW and reconnecting. Thus PGVIEW could actually point to a shell script which could do anything including using rsh to start pgview on a remote system. You are only limited by your imagination and your network security policies. Remember that as part of the standard NeXT interface, holding down the alternate key while clicking in the title bar will bring the window to the top without making it key. Use the main menu to select either a Portrait or Landscape window. Although the window can be resized, PGPLOT produces slightly different output depending on the original aspect ratio of the plot. These aspect ratios were selected to match the aspect ratios of the /PS and /VPS devices. If you start with a Landscape window, then no matter how you resize the window with the resize bar, PGPLOT will still assume the same aspect ratio when drawing. In other words, you first create a plot and then resize window, it will look exactly the same as if you had first first resized the window and then created the plot. When PGPLOT starts, it plots to the most recently active viewer window i.e., the last key window. The viewer will not allow you to change the active plot window while a plot is in progress. If pgplot has not closed the plot (by sending an end_picture) then the window is marked as "edited" and you will not be able to delete the window. BUG REPORTS: Please send bug-reports/suggestions/thank-you notes (but not money) to: Internet: allyn.tennant@msfc.nasa.gov Do NOT send NextMail to that address. Like all free support, you get what you pay for. pgplot/sys_openstep/g77_gcc.conf010064400040640000322000000075050665611424600173750ustar00tjpcitmbr00000400000017# The GNU g77 FORTRAN compiler and the gcc C compiler. # Experimental: please report problems or fixes. #----------------------------------------------------------------------- # Optional: Needed by XWDRIV (/xwindow and /xserve) and # X2DRIV (/xdisp and /figdisp). # The arguments needed by the C compiler to locate X-window include files. XINCL="-I/usr/X11R6/include" # Optional: Needed by XMDRIV (/xmotif). # The arguments needed by the C compiler to locate Motif, Xt and # X-window include files. MOTIF_INCL="" # Optional: Needed by TKDRIV (/xtk). # The arguments needed by the C compiler to locate Tcl, Tk and # X-window include files. TK_INCL="-I/usr/local/include " # Optional: Needed by RVDRIV (/xrv). # The arguments needed by the C compiler to locate Rivet, Tcl, Tk and # X-window include files. RV_INCL="" # Mandatory. # The FORTRAN compiler to use. FCOMPL="g77" # Mandatory. # The FORTRAN compiler flags to use when compiling the pgplot library. # (NB. makemake prepends -c to $FFLAGC where needed) FFLAGC="-fno-backslash -Wimplicit -O" # Mandatory. # The FORTRAN compiler flags to use when compiling fortran demo programs. # This may need to include a flag to tell the compiler not to treat # backslash characters as C-style escape sequences FFLAGD="-fno-backslash -Wimplicit -O" # Mandatory. # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to use when compiling C demo programs. CFLAGD="" # Optional: Only needed if the cpgplot library is to be compiled. # The flags to use when running pgbind to create the C pgplot wrapper # library. (See pgplot/cpg/pgbind.usage) PGBIND_FLAGS="" # Mandatory. # The library-specification flags to use when linking normal pgplot # demo programs. LIBS="-L/usr/X11R6/lib -lX11" # Optional: Needed by XMDRIV (/xmotif). # The library-specification flags to use when linking motif # demo programs. MOTIF_LIBS="-lXm -lXt " # Optional: Needed by TKDRIV (/xtk). # The library-specification flags to use when linking Tk demo programs. # Note that you may need toÈÏ append version numbers to -ltk and -ltcl. TK_LIBS="-L/usr/local/lib -ltk -ltcl -ldl" # Mandatory. # On systems that have a ranlib utility, put "ranlib" here. On other # systems put ":" here (Colon is the Bourne-shell do-nothing command). RANLIB="ranlib" # Optional: Needed on systems that support shared libraries. # The name to give the shared pgplot library. SHARED_LIB="" # Optional: Needed if SHARED_LIB is set. # How to create a shared library from a trailing list of object files. SHARED_LD="" # Optional: # On systems such as Solaris 2.x, that allow specification of the # libraries that a shared library needs to be linked with when a # program that uses it is run, this variable should contain the # library-specification flags used to specify these libraries to # $SHARED_LD SHARED_LIB_LIBS="" # Optional: # Compiler name used on Next systems to compile objective-C files. MCOMPL="cc" # Optional: # Compiler flags used with MCOMPL when compiling objective-C files. MFLAGC="-DPG_PPU -I$SYSDIR/pgview" # Optional: (Actually mandatory, but already defined by makemake). # Where to look for any system-specific versions of the files in # pgplot/sys. Before evaluating this script, makemake sets SYSDIR to # /wherever/pgplot/sys_$OS, where $OS is the operating-system name # given by the second command-line argument of makemake. If the # present configuration is one of many for this OS, and it needs # different modifications to files in pgplot/sys than the other # configurations, then you should create a subdirectory of SYSDIR, # place the modified files in it and change the following line to # $SYSDIR="$SYSDIR/subdirectory_name". SYSDIR="$SYSDIR/g77_src" . # The C compiler to use. CCOMPL="gcc" # Mandatory. # The C compiler flags to use when compiling the pgplot library. CFLAGC="-DPG_PPU" # Mandatory. # The C compiler flags to uspgplot/ver522.txt010064400040640000322000000012400724652106600143250ustar00tjpcitmbr00000400000017PGPLOT version 5.2.2 This version is a maintenance release. It introduces no new subroutines or functionality. Modified configuration files Configuration files for aix, linux, and solaris have been updated. Windows support The files sys_win/aaaread.me and sys_win/gidriv.f have been modified. Modified device drivers Minor bugs in the X-window device drivers have been corrected. Changes to PGPLOT subroutines pgqinf Returns new version number (5.2.2). ---------------------------------------------------------------------------- Tim Pearson, California Institute of Technology, tjp@astro.caltech.edu Copyright © 1999 California Institute of Technology