C $Id: mgftest.f,v 1.1.1.1 1996/11/04 12:05:46 roitzsch Exp $ C (C)opyright 1996 by Konrad-Zuse-Center, Berlin C All rights reserved. C Part of the common environment C PROGRAM testmini INCLUDE 'parameter.h' REAL X(5), Y(5), x1, y1, x2, y2 INTEGER IDSCR, NO1, NO2, NO3, NO4, IDPS, NOPS1, NOPS2, NOPS3, $ NOPS4, ASS, COLNO, R, G, B, typ, button, ch C WRITE(6,100) C IDSCR = SCREEN ASS = 1 CALL ZIBWOP(IDSCR, NO1) CALL ZIBSET(IDSCR, NO1, ASS, CAPTION, 'Rechts oben') C CALL ZIBWOP(IDSCR, NO2) CALL ZIBSET(IDSCR, NO2, ASS, CAPTION, 'Links oben') CALL ZIBSET(IDSCR, NO2, ASS, SCALFIT, 0) C CALL ZIBWOP(IDSCR, NO3) CALL ZIBSET(IDSCR, NO3, ASS, CAPTION, 'Links unten') CALL ZIBSET(IDSCR, NO3, ASS, MINX, 0.6) CALL ZIBSET(IDSCR, NO3, ASS, MINY, 0.84) CALL ZIBSET(IDSCR, NO3, ASS, MAXX, 0.7) CALL ZIBSET(IDSCR, NO3, ASS, MAXY, 0.94) C CALL ZIBWOP(IDSCR, NO4) CALL ZIBSET(IDSCR, NO4, ASS, CAPTION, 'Rechts unten') CALL ZIBSET(IDSCR, NO4, ASS, MINX, 0.50) CALL ZIBSET(IDSCR, NO4, ASS, MINY, 0.50) CALL ZIBSET(IDSCR, NO4, ASS, MAXX, 0.95) CALL ZIBSET(IDSCR, NO4, ASS, MAXY, 0.7) C IDPS = PS_QUER CALL ZIBWOP(IDPS, NOPS1) CALL ZIBWOP(IDPS, NOPS2) CALL ZIBSET(IDPS, NOPS2, ASS, FILENAME, 'Postscript_2') CALL ZIBSET(IDPS, NOPS2, ASS, SCALFIT, 0) CALL ZIBWOP(IDPS, NOPS3) CALL ZIBSET(IDPS, NOPS3, ASS, FILENAME, 'Postscript_3') CALL ZIBSET(IDPS, NOPS3, ASS, MINX, 0.6) CALL ZIBSET(IDPS, NOPS3, ASS, MINY, 0.84) CALL ZIBSET(IDPS, NOPS3, ASS, MAXX, 0.7) CALL ZIBSET(IDPS, NOPS3, ASS, MAXY, 0.94) CALL ZIBWOP(IDPS, NOPS4) CALL ZIBSET(IDPS, NOPS4, ASS, SCALFIT, 1) CALL ZIBSET(IDPS, NOPS4, ASS, WDORGX, 300) CALL ZIBSET(IDPS, NOPS4, ASS, WDORGY, 20) CALL ZIBSET(IDPS, NOPS4, ASS, WDWDTH, 500) CALL ZIBSET(IDPS, NOPS4, ASS, WDHGHT, 250) CALL ZIBSET(IDPS, NOPS4, ASS, MINX, 0.40) CALL ZIBSET(IDPS, NOPS4, ASS, MINY, 0.50) CALL ZIBSET(IDPS, NOPS4, ASS, MAXX, 0.9) CALL ZIBSET(IDPS, NOPS4, ASS, MAXY, 0.75) C CALL ZIBADD (IDSCR, NO1, IDSCR, NO2) CALL ZIBADD (IDSCR, NO1, IDSCR, NO3) CALL ZIBADD (IDSCR, NO1, IDSCR, NO4) CALL ZIBADD (IDSCR, NO1, IDPS, NOPS1) CALL ZIBADD (IDSCR, NO2, IDPS, NOPS2) CALL ZIBADD (IDSCR, NO3, IDPS, NOPS3) CALL ZIBADD (IDSCR, NO4, IDPS, NOPS4) C CALL ZIBSET(IDPS, NOPS1, ASS, FILENAME, 'Postscript_1') COLNO = 42 R = 150 G = 0 B = 0 CALL ZIBCOL(ALL, COLNO, R, G, B) CALL ZIBSET(IDSCR, NO1, 0, BACKGRCOL, COLNO) CALL ZIBSET(IDPS, NOPS1, 0, BACKGRCOL, COLNO) COLNO = 43 R = 200 G = 150 B = 110 CALL ZIBCOL(ALL, COLNO, R, G, B) CALL ZIBSET(IDSCR, NO3, ASS, BACKGRCOL, COLNO) C X(1) = 0.0 Y(1) = 0.0 X(2) = 1.0 Y(2) = 0.0 X(3) = 1.0 Y(3) = 1.0 X(4) = 0.0 Y(4) = 1.0 X(5) = 0.0 Y(5) = 0.0 C CALL ZIBSET(IDPS, NOPS1, 0, PENCOL, WHITE) CALL ZIBSET(IDPS, NOPS2, 0, PENCOL, WHITE) CALL ZIBSET(IDPS, NOPS2, 0, BACKGRCOL, BLACK) CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, BIG) CALL ZIBPL(IDSCR, NO1, ASS, X, Y, 5) C CALL ZIBSET(IDPS, NOPS1, 0, FONTCOL, WHITE) CALL ZIBSET(IDPS, NOPS2, 0, FONTCOL, WHITE) CALL ZIBTX(IDSCR, NO1, ASS, 0.01, 0.97, 'PolyLines') CALL TPL(IDSCR, NO1, ASS, 0.05, 0.93, SMALL, 'small') CALL TPL(IDSCR, NO1, ASS, 0.05, 0.89, MEDIUM, 'medium') CALL TPL(IDSCR, NO1, ASS, 0.05, 0.85, BIG, 'big') C CALL CIRC(IDSCR, NO1, ASS, 0.50, 0.89, 0.04, 200, SMALL, GREEN) CALL CIRC(IDSCR, NO1, ASS, 0.65, 0.89, 0.04, 100, MEDIUM, RED) CALL CIRC(IDSCR, NO1, ASS, 0.80, 0.89, 0.04, 50, BIG, BLUE) C CALL ZIBTX(IDSCR, NO1, ASS, 0.01, 0.77, 'PolyMarkers') CALL TPM(IDSCR, NO1, ASS, 0.05, 0.73, STAR, 'star', YELLOW) CALL TPM(IDSCR, NO1, ASS, 0.05, 0.69, CROSS, 'cross', RED) CALL TPM(IDSCR, NO1, ASS, 0.05, 0.65, PLUS, 'plus', GREEN) CALL TPM(IDSCR, NO1, ASS, 0.05, 0.61, BULLET, 'bullet', BLUE) CALL TPM(IDSCR, NO1, ASS, 0.05, 0.57, CIRCCROSS, 'circcross', 1 CYAN) CALL TPM(IDSCR, NO1, ASS, 0.05, 0.53, CIRCPLUS, 'circplus', 1 MAGENTA) CALL ZIBSET(IDSCR, NO1, ASS, MARKER, PLUS) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.5, 0.15, 10, 0.0, 1 0.0, STAR, DOTTED, YELLOW) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.4, 0.15, 10, -0.04, 1 0.0, CROSS, LONG_DOTTED, RED) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.45, 0.15, 10, 0.04, 1 0.5, PLUS, DASHED, GREEN) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.35, 0.15, 10, 0.04, 1 1.0, BULLET, LONG_DASHED, BLUE) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.48, 0.15, 10, -0.06, 1 -0.5, CIRCCROSS, DASHDOT, CYAN) CALL CURVE(IDSCR, NO1, ASS, 0.45, 0.55, 0.42, 0.15, 10, -0.02, 1 -1.0, CIRCPLUS, DASHDOTDOTTED, MAGENTA) C CALL ZIBTX(IDSCR, NO1, 1, 0.01, 0.45, 'Text') CALL TTX(IDSCR, IDPS, NO1, ASS, 0.05, 0.41, SMALL, 'small', 1 RED) CALL TTX(IDSCR, IDPS, NO1, ASS, 0.05, 0.37, MEDIUM, 'medium', 1 CYAN) CALL TTX(IDSCR, IDPS, NO1, ASS, 0.05, 0.33, BIG, 'big', GREEN) C CALL ZIBTX(IDSCR, NO1, 1, 0.01, 0.25, 'Fill') CALL ZIBREQ(IDSCR, NO1, MAXGRY, IGRY) CALL TFL(IDSCR, NO1, ASS, 0.155, 0.05, 24, 8) C WRITE (6, 102) CALL ZIBGIN(IDSCR, NO1, 1, x1, y1, x2, y2) WRITE (6, 104) x1, y1 WRITE (6, 105) x2, y2 C WRITE (6, 103) CALL ZIBGIN(IDSCR, NO4, 2, x1, y1, x2, y2) WRITE (6, 104) x1, y1 WRITE (6, 105) x2, y2 C WRITE(6, 106) CALL ZIBWT(IDSCR, NO2, typ, button, x1, y1, ch) WRITE(6, 107) typ, button, ch WRITE(6, 104) x1, y1 C CALL ZIBCLR (IDSCR, NO1, 0) CALL ZIBCLR (IDSCR, NO2, 0) CALL ZIBCLR (IDSCR, NO3, 0) CALL ZIBCLR (IDSCR, NO4, 0) c CALL ZIBSET (IDSCR, NO2, 0, FONTSIZE, BIG) CALL ZIBSET (IDSCR, NO2, 0, FONTCOL, RED) CALL ZIBTX (IDSCR, NO2, 0, 0.45, 0.5, 'T H E E N D') C WRITE(6, 106) CALL ZIBWT(IDSCR, NO2, typ, button, x1, y1, ch) WRITE(6, 107) typ, button, ch WRITE(6, 104) x1, y1 C CALL ZIBWCL(IDSCR, NO1, ASS) WRITE(6,101) STOP 100 FORMAT('Start Minitest') 101 FORMAT('Ende Minitest') 102 FORMAT(' "Rechts oben" Line :') 103 FORMAT(' "Rechts unten" Rectangle :') 104 FORMAT(' x1 : ', f6.3, ' y1 : ', f6.3) 105 FORMAT(' x2 : ', f6.3, ' y2 : ', f6.3) 106 FORMAT(' "Links oben" Wait :') 107 FORMAT(' typ : ', i2, ' button : ', i2, ' char : ', i5) C END C SUBROUTINE TPL(IDSCR, NO1, ASS, X, Y, SIZE, S) INCLUDE 'parameter.h' CHARACTER S*(*) REAL XA(2), YA(2) C CALL ZIBTX(IDSCR, NO1, ASS, X, Y, S) CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, SIZE) XA(1) = X+0.15 XA(2) = X+0.35 YA(1) = Y YA(2) = Y CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 2) RETURN END C SUBROUTINE TPM(IDSCR, NO1, ASS, X, Y, MARK, S, ICOL) INCLUDE 'parameter.h' CHARACTER S*(*) C CALL ZIBTX(IDSCR, NO1, ASS, X, Y, S) CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, SMALL) CALL ZIBSET(IDSCR, NO1, ASS, MARKER, MARK) CALL ZIBSET(IDSCR, NO1, ASS, MARKCOL, ICOL) C CALL TPMRK(IDSCR, NO1, ASS, X+0.2, Y) CALL TCMRK(IDSCR, NO1, ASS, X+0.3, Y) RETURN END C SUBROUTINE TTX(IDSCR, IDPS, NO1, ASS, X, Y, SIZE, S, ICOL) INCLUDE 'parameter.h' CHARACTER S*(*) C CALL ZIBTX(IDSCR, NO1, ASS, X, Y, S) CALL ZIBSET(IDSCR, NO1, ASS, FONTSIZE, SIZE) CALL ZIBSET(IDSCR, NO1, ASS, FONTCOL, ICOL) CALL ZIBTX(IDSCR, NO1, ASS, X+0.15, Y, 1 'Einfacher Text ohne Umlaute: 123456789') CALL ZIBSET(IDSCR, NO1, ASS, FONTSIZE, MEDIUM) CALL ZIBSET(IDSCR, NO1, ASS, FONTCOL, WHITE) RETURN END C SUBROUTINE TFL(IDSCR, NO1, ASS, X, Y, NO, IGRAY) INCLUDE 'parameter.h' REAL XA(5), YA(5) C YA(1) = Y YA(2) = Y YA(3) = Y+0.2 YA(4) = Y+0.2 YA(5) = Y DIFF = (1.0-2*X)/NO CALL ZIBSET(IDSCR, NO1, ASS, LINESTYLE, SOLID) CALL ZIBSET(IDSCR, NO1, ASS, PENCOL, MAGENTA) DO 10, I=1,NO CALL ZIBSET(IDSCR, NO1, ASS, FILLCOL, IGRAY+I-1) XA(1) = X+(I-1)*DIFF XA(2) = XA(1)+DIFF XA(3) = XA(2) XA(4) = XA(1) XA(5) = XA(1) CALL ZIBFL(IDSCR, NO1, ASS, XA, YA, 5) CALL ZIBSET(IDSCR, NO1, 0, BUFFER, FLUSH) 10 CONTINUE XA(1) = X XA(2) = 1.0-X XA(3) = 1.0-X XA(4) = X XA(5) = X CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, BIG) CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 5) RETURN END C SUBROUTINE TPMRK(IDSCR, NO1, ASS, X, Y) INCLUDE 'parameter.h' REAL XA(2), YA(2) C XA(1) = X-0.015 XA(2) = X+0.015 YA(1) = Y YA(2) = Y CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 2) XA(1) = X XA(2) = X YA(1) = Y-0.015 YA(2) = Y+0.015 CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 2) CALL ZIBPM(IDSCR, NO1, ASS, X, Y, 1) RETURN END C SUBROUTINE TCMRK(IDSCR, NO1, ASS, X, Y) INCLUDE 'parameter.h' REAL XA(2), YA(2) C XA(1) = X-0.015 XA(2) = X+0.015 YA(1) = Y-0.015 YA(2) = Y+0.015 CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 2) XA(1) = X-0.015 XA(2) = X+0.015 YA(1) = Y+0.015 YA(2) = Y-0.015 CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, 2) CALL ZIBPM(IDSCR, NO1, ASS, X, Y, 1) RETURN END C SUBROUTINE CIRC(IDSCR, NO1, ASS, X, Y, R, NO, SIZE, ICOL) INCLUDE 'parameter.h' REAL XA(1001), YA(1001) C PISEG = 6.283185/NO DO 10, I=1,NO+1 PHI = (I-1.0)*PISEG XA(I) = X+R*SIN(PHI) YA(I) = Y+R*COS(PHI) 10 CONTINUE CALL ZIBSET(IDSCR, NO1, ASS, FILLCOL, ICOL) CALL ZIBFL(IDSCR, NO1, ASS, XA, YA, NO+1) CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, SIZE) CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, NO+1) C RETURN END C SUBROUTINE CURVE(IDSCR, NO1, ASS, X, Y, DX, DY, NO, F1, PHI, 1 MARK, PATTERN, ICOL) INCLUDE 'parameter.h' REAL XA(1001), YA(1001) DDX = DX/NO DDY = DY/NO DO 10, I=1,NO XA(I) = X+(I-1.0)*DDX YA(I) = Y+I*DDY+F1*SIN(PHI+20.0*XA(I)) 10 CONTINUE CALL ZIBSET(IDSCR, NO1, ASS, PENSIZE, SMALL) CALL ZIBSET(IDSCR, NO1, ASS, LINESTYLE, PATTERN) C CALL ZIBSET(IDSCR, NO1, ASS, MARKER, MARK) CALL ZIBSET(IDSCR, NO1, ASS, PENCOL, ICOL) CALL ZIBSET(IDSCR, NO1, ASS, MARKCOL, ICOL) CALL ZIBPL(IDSCR, NO1, ASS, XA, YA, NO) C CALL ZIBPM(IDSCR, NO1, ASS, XA, YA, NO) C RETURN END