C --- Beispielprogramm zum Aufruf einiger Grafikfunktionen ueber 
C     eine Schnittstelle zur X11-Bibliothek
C     Verwendung von Zufallszahlen mit der Funktion rand()
C ----------------------------------------------------- M. Pester ----
C                                                       04.05.05
C Vollstaendige Beschreibung der Grafikunterprogramme unter
C   http://www.tu-chemnitz.de/sfb393/Files/PDF/sfb02-01a.pdf
C (Seiten 33-39)
C --------------------------------------------------------------------

	program Zufallspixel
	character*50 head
	integer i, col(110), nx, ny, restart
	logical grafik, rainbow, halt, lines
	integer, allocatable, dimension(:) :: seeds
	NAMELIST /param/ rainbow,halt,lines,restart,nx,ny
	
	DATA rainbow / .FALSE. /   ! true: 100 Farben, false: 3 Farben
	DATA halt    / .FALSE. /   ! true: Pause nach jedem nx*ny-Zyklus
	DATA lines   / .FALSE. /   ! true: vertikale Linien, false: Pixel
	DATA restart / -1 /        ! n>0 : Wdh. Zufallszahlenfolge nach n Pixeln 
	DATA nx /601/, ny /601/    ! Fenstergroesse
	
	call random_seed(size=ii)
	WRITE(*,*) 'Random_Seed Size=',ii
	ALLOCATE(seeds(ii))
	call random_seed
	call random_seed(get=seeds)
	WRITE(*,*) 'Seed-Werte:'
	WRITE(*,*) seeds
	call gopenserver(i)	   ! Verbindung mit dem X-Server
	grafik = (i .EQ. 0) 	   ! Zugriff erlaubt?
	if (grafik) then
	  write (*,4)
	  write (*,5)
	  write (*,4)
4         Format(1X,60('-'))
5	  Format(' Bedeutung der NAMELIST-Variablen:'/
     +    '  RAINBOW : .TRUE. => 100 Farben, .FALSE. => 3 Farben'/
     +    '  HALT    : .TRUE. => Pause nach nx*ny Pixeln'/
     +    '  LINES   : .TRUE. => vertikale Linien statt Pixel'/
     +    '  RESTART : n>0    => Wiederhole Zufallsfolge nach n Pixeln'/
     +    '  NX,NY   : Anzahl Pixel in x-, y-Richtung')
C Namelist-Ausgabe: Voreinstellungen:     
	  write(*,NML=param)
C Namelist-Eingabe: wahlweise Parameterwerte aendern	  
	  write(*,*) 'Bitte nach obigem Muster Werte aendern:'
	  read(*,NML=param,END=1)
C Namelist-Ausgabe: verwendete Einstellungen	  
	  write(*,NML=param)
	endif
	
1	continue
C	WRITE(*,'(/1x,2A,$)') 'Zur Initialisierung ein beliebiger ',
C     +		'(ganzzahliger) Seed-Wert: '
C	READ (*,*,ERR=1) ii
C	call srand(ii)

	call random_seed(put=seeds)  ! wiederhole dieselbe Zufallszahlenfolge

	  if (rainbow) then
	    nc=100
	  else  
	    nc=3  
	  endif  
	write(*,*) 'Anfang einer Zufallszahlenfolge:'
	do i=1,10 
C  	  x=rand()
	  call random_number(x)
	  write(*,10)x,int(nx*x),int(ny*x),int(nc*x)
10	  Format(F12.9,3I6)	  
	enddo
	if (grafik) then
	  write(*,*) 'Beenden mit ESC, Pause mit sonstiger Taste.'
	  write(*,*) ' ...'
	  icycle=0
	  call gwhitepixel(iwhite)
	  call gblackpixel(iblack)
	  if (rainbow) then
	    nc=100
	    call graincolor(col)
	  else  
	    nc=3  
	    call galloccolor(65535,0,0,col(1))    ! rot
	    call galloccolor(0,65535,0,col(2))    ! gruen
	    call galloccolor(0,0,65535,col(3))    ! blau
	  endif  
	  call gopenwin(iw,nx,ny)
	  call gsetforeground(iw,iblack)
	  call gclearwin(iw)
	  if (lines) then
	    ncycle=nx
	  else
	    ncycle=nx*ny
	  endif  
	  nrand=restart   
	  DO WHILE(grafik)
	    icycle=icycle+1
	    write(head,*) 'Zufallspixel:',icycle
	    call gstorename(iw,head)
	    call gsync
	    DO i=1,ncycle
	      call random_number(x)
	      ix=int(nx*x)	      
C	      ix=int(nx*rand())	      
	      call random_number(x)
	      ic=int(nc*x)
C	      ic=int(nc*rand())
	      call gsetforeground(iw,col(ic+1))
	      if (lines) then
	        call gdrawline(iw,ix,0,ix,ny-1)
	      else
	        call random_number(x)
                iy=int(ny*x)
C	        iy=int(ny*rand())
	        call gdrawpoint(iw,ix,iy)
	      endif	
	      if (restart .gt. 0) then
	        nrand=nrand-1
		if (nrand .eq. 0) then
		  call random_seed(put=seeds)
		  nrand=restart
		endif
	      endif
	    ENDDO
	    call gsync
	    if (halt) then              ! Programm wartet auf Tastendruck
	      istat=0
	      DO while (istat .EQ. 0)
	        call gWaitEvents(iw)	    ! entlastet CPU beim Warten
	        call gkeypressed(iw,istat)  ! Maus-Events ignorieren
	      ENDDO  
	    else  
	      call gkeypressed(iw,istat)    ! Tastendruck zwischendurch?
	    endif  
	    if (istat .EQ. 1) then	! PAUSE
	      call greadkey(iw,ic)	! 1 Zeichen aus Tastaturpuffer
	      call gclearkeys(iw)	! ggf. restlichen Tastaturpuffer löschen
	      if (ic .EQ. ichar('h')) halt=.NOT. halt
	      if (.NOT. halt .AND. (ic .NE. 27)) then
	        head(30:34)='PAUSE'
		call gstorename(iw,head)
		call gsync
	        istat=0
		do while (istat .EQ. 0) ! (immer noch PAUSE)
		  call gWaitEvents(iw)  ! entlastet CPU beim Warten
		  call gkeypressed(iw,istat)
		enddo
		call greadkey(iw,ic)	! CONTINUE
		call gclearkeys(iw)  	! Tastaturpuffer jetzt erstmal leer
	      endif
	      grafik = (ic .ne. 27)	! ESC=Abbruch
	    else
	      head(30:34)=' '
	      call gstorename(iw,head)
	    endif
	  ENDDO
	  call gclosewin(iw)
	else
C	  pause 'if(grafik) then ... else ...?'
 	  goto 1
	endif  
	stop
	end