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
