	PROGRAM APFEL1
C	20.11.85 WI/1
C	MANDELBROT-GRAPHIC.
C
C	FUNCTIONAL DESCRIPTION :
C
C	The color of an array of points in the complex plane is
C	evaluated by a special algorithm.The result is drawn as
C	a picture on the screen with the aid of the CORE-Graphic
C	System.The Picture-Resolution can be selected from 1...40
C	by a special parameter,e.g :
C
C		Resolution  =	 1  ->  X : Y  =  18 :  12
C		Resolution  =	10  ->  X : Y  = 180 : 120
C		Resolution  =	40  ->  X : Y  = 720 : 480
C
C	The 'color' of the Start-Value SX/SY in the Complex-Plane is
C	transformed to the origin of a window with the relative size
C	of SX+DX / SY+DY in the World-Coordinate-System.The dimensions
C	of this window are given by the selected resolution.The
C	window's origin is located at the lower-left corner.A special
C	algorithm is applied to compute the color of every point
C	(see explanation in subroutine CHAOS4) in the selected part of
C	the Complex-Plane.With the help of the Cursor-Keys you can
C	select a region of interest.That region can be magnified by
C	factor 0.001...1000.The picture is saved in a Graphic-Metafile.
C
	INCLUDE 'LB:[1,5]CGL.FTN'
C
	REAL*4		SX,SY,DX,DY
	INTEGER*2	SAVE(24),ORIGIN,IFCO,N,IX,IY,FACT,NX,NY
	INTEGER*2	WHITE(3),SELECT,STATUS(2)
	REAL*4		VXM,VXP,VYM,VYP,WXM,WXP,WYM,WYP
	REAL*4		LWX,LWY,LWXO,LWYO
	REAL*4		RSX,RSY,RDX,RDY,DELX,DELY,MAGNIF
	LOGICAL		YES
	CHARACTER*1	ESC,BEL
	CHARACTER*10	FILNAM
	CHARACTER*6	NAMFIL
	CHARACTER*55	LE
C
	DATA		ESC/27/			!ASCII-ESC.
	DATA		BEL/7/			!ASCII-BELL.
	DATA		FILNAM/'      .GID'/	!PICTURE FILE.
	DATA		WHITE/7,7,6/
	DATA LE/'I:    X:       Y:       W:          R:    F:           '/
C
71	FORMAT(1H+,A1,'[2J')			!DEFINE ERASE SCREEN.
72	FORMAT(1H+,A1,'[?6l')			!DEFINE CURSOR HOME.
73	FORMAT(1H+,A1,'[24;1H',50X,' To continue,press RESUME ! ')
74	FORMAT(1H+,A1,'[24;1H',' Select region of interest !            ')
76	FORMAT(1H+,A1,A1,'[24;1H',' Use SELECT or Cursor-Keys !         ')
77	FORMAT(1H+,A1,'[24;1H','X:',F10.5,' Y:',F10.5,' DX:',F10.6,' DY:',
     *	F10.6)
C
	IFCO=5					!DIALOG  FILECODE.
	ORIGIN=0				!ORIGIN : BOTTOM LEFT.
	VXM=0.0					!SELECT -
	VXP=1.0					! -
	VYM=0.0					! -
	VYP=1.0					!VIEWPORT.
	IX=18					!BASIC X-POINTS.
	IY=12					!BASIC Y-POINTS.
C
55	WRITE(IFCO,71)ESC			!CLEAR SCREEN.
	WRITE(IFCO,72)ESC			!CURSOR HOME.
C
	WRITE(IFCO,100)
100	FORMAT(10X,'Graphical Presentation of the Mandelbrot_Set :',//)
C
	TYPE '(1X,A,//)','Graphic-Microscope with Filing !'
C
315	WRITE(IFCO,'(1H$,''Select X-Start Position    |...10.0| : '')')
	READ(IFCO,'(F6.2)',ERR=315)SX
	IF(SX.LT.-10.0.OR.SX.GT.10.0)GOTO 315
C
325	WRITE(IFCO,'(1H$,''Select Y-Start Position    |...10.0| : '')')
	READ(IFCO,'(F6.2)',ERR=325)SY
	IF(SY.LT.-10.0.OR.SY.GT.10.0)GOTO 325
C
335	WRITE(IFCO,'(1H$,''Select Window-Edge          0...10.0 : '')')
	READ(IFCO,'(F6.2)',ERR=335)DX
	IF(DX.LT.0.0.OR.DX.GT.10.0)GOTO 335
C
	DY=DX*(FLOAT(IY)/FLOAT(IX))		!COMPUTE WINDOW-HEIGHT.
C
345	WRITE(IFCO,'(1H$,''Number of planned iterations    (I5) : '')')
	READ(IFCO,'(I5)',ERR=345)N
C
365	WRITE(IFCO,'(1H$,''Resolution-Factor           (1...40) : '')')
	READ(IFCO,'(I2)',ERR=365)FACT
	IF(FACT.LT.1.OR.FACT.GT.40)GOTO 365
C
	WRITE(IFCO,'(1H$,''Picture Filename,6 characters max.   : '')')
	READ(IFCO,'(A)')NAMFIL
	FILNAM(1:6)=NAMFIL
C
	WRITE(LE(3:6),'(I4)')N			!BUILD -
	WRITE(LE(9:15),'(F7.3)')SX		!LEGEND -
	WRITE(LE(18:24),'(F7.3)')SY		!STRING -
	WRITE(LE(27:36),'(F10.6)')DX		!WITH -
	WRITE(LE(39:42),'(I4)')FACT		!INTERNAL -
	WRITE(LE(46:55),'(A)')FILNAM		!WRITE.
C
C	COMPUTE WINDOW DATA :
C
	WXM=SX					!COMPUTE -
	WXP=SX+DX				! -
	WYM=SY					! -
	WYP=SY+DY				!WINDOW.
C
	RSX=WXM					!START -
	RSY=WYM					!POSITION -
	RDX=WXP-WXM				!FOR -
	RDY=WYP-WYM				!MAGNIFICATION.
C
C	INITIALIZE GRAPHIC SYSTEM :
C
	CALL CGL(GIC)				!INITIALIZE_CORE.
	CALL CGL(GIVS,FILNAM,LEN(FILNAM))	!INITIALIZE_VIEW_SUR.
	CALL CGL(GSVS,FILNAM,LEN(FILNAM))	!SELECT_VIEW_SURFACE.
	CALL CGL(GNF)				!NEW_FRAME.
	CALL CGL(GSV2,VXM,VXP,VYM,VYP)		!SET_VIEWPORT.
	CALL CGL(GSW,WXM,WXP,WYM,WYP)		!SET_WINDOW.
	CALL CGL(GSO,ORIGIN)			!SET_ORIGIN.
	CALL CGL(GRA2,WXP,WYP)			!RECTANGLE_ABS.
	CALL CGL(GMA2,WXM,WYM)			!MOVE_ABS_2.
C
	CALL CGL(GICM,SAVE)			!INQUIRE_COLOR_MAP.
	CALL CGL(GILW,LWXO,LWYO)		!INQUIRE_LINEWIDTH.
C
	LWX=(WXP-WXM)/(IX*FACT)			!COMPUTE -
	LWY=2.0*(WYP-WYM)/(IY*FACT)		!LINEWIDTH.
	IF(FACT.GT.20)LWY=LWY*2.0		!DUE TO INTERLACE.
C
	CALL CGL(GSLW,LWX,-LWY)			!SET_LINEWIDTH.
C
C	CHAOS COMPUTATION PART :
C
	NX=FACT*IX				!X-POINTS.
	NY=FACT*IY				!Y-POINTS.
C
	CALL CHAOS4(NX,NY,SX,SY,DX,DY,N)	!EXPLAN. SEE CHAOS4.
C
C	SELECT REGION OF INTEREST :
C
	CALL CGL(GDVS,FILNAM,LEN(FILNAM))	!DESELECT_VIEW_SURFACE.
	WRITE(IFCO,74)ESC			!INFORM OPERATOR.
	CALL CGL(GMA2,RSX,RSY)			!MOVE_ABSOLUTE_2.
C
	DELX=RDX/100.0
	DELY=RDY/100.0
301	CALL GETKEY(STATUS)
	IF(STATUS(1).EQ.2)THEN
		IF(STATUS(2).EQ.24)THEN
			GOTO 302
		ELSE IF(STATUS(2).EQ.27)THEN
			RSY=RSY+DELY
			CALL CGL(GMA2,RSX,RSY)
		ELSE IF(STATUS(2).EQ.28)THEN
			RSX=RSX-DELX
			CALL CGL(GMA2,RSX,RSY)
		ELSE IF(STATUS(2).EQ.29)THEN
			RSY=RSY-DELY
			CALL CGL(GMA2,RSX,RSY)
		ELSE IF(STATUS(2).EQ.30)THEN
			RSX=RSX+DELX
			CALL CGL(GMA2,RSX,RSY)
		ELSE
			GOTO 303
		END IF
	ELSE
		GOTO 303
	END IF
C
	WRITE(IFCO,77)ESC,RSX,RSY,RDX,RDY	!SHOW POSITION.
	CALL CGL(GMA2,RSX,RSY)			!MOVE_ABSOLUTE_2.
	GOTO 301
C
303	WRITE(IFCO,76)BEL,ESC			!SEND MESSAGE.
	CALL CGL(GMA2,RSX,RSY)			!MOVE_ABSOLUTE_2.
	GOTO 301
C
C	WRITE LEGEND :
C
302	CONTINUE
	CALL CGL(GSVS,FILNAM,LEN(FILNAM))	!SELECT_VIEW_SURFACE.
	CALL CGL(GSCME,7,WHITE)			!SET_COLOR_MAP_ENTRY.
	CALL CGL(GSWI,7)			!SET_WRITING_INDEX.
	CALL CGL(GMA2,WXM,WYP)			!MOVE_ABS_2.
	CALL CGL(GT,LE,LEN(LE))			!TEXT.
C
	WRITE(IFCO,73)ESC			!SEND RESUME MESSAGE.
	CALL WTRES				!WAIT FOR RESUME.
C
	WRITE(IFCO,71)ESC			!CLEAR SCREEN.
	WRITE(IFCO,72)ESC			!CURSOR HOME.
C
C	TERMINATE GRAPHIC SYSTEM :
C
	CALL CGL(GDVS,FILNAM,LEN(FILNAM))	!DESELECT_VIEW_SURFACE.
	CALL CGL(GSCM,SAVE)			!SET_COLOR_MAP.
	CALL CGL(GSLW,LWXO,LWYO)		!SET_LINEWIDTH.
	CALL CGL(GNF)				!NEW_FRAME.
	CALL CGL(GTC)				!TERMINATE_CORE.
C
	CALL YESNO(IFCO,YES,27,'You can now stop painting ?')
	IF(.NOT.YES)THEN
C
304	WRITE(IFCO,'(1H$,''Select Magnification 0.001...1000.0 : '')')
	READ(IFCO,'(F6.1)',ERR=304)MAGNIF
	IF(MAGNIF.LT.0.001.OR.MAGNIF.GT.1000.0)GOTO 304
C
	SX=RSX
	SY=RSY
	DX=RDX/MAGNIF
	DY=RDY/MAGNIF
	GOTO 345
C
	ELSE
C
	CONTINUE
C
	END IF
C
 	TYPE '(1X,//,1X,A,//)','APFEL1 : See YOU later !'
C
	CALL EXIT
C
	END