PROGRAM APFEL2 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 upper-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. 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),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*55 LE C DATA ESC/27/ !ASCII-ESC. DATA BEL/7/ !ASCII-BELL. 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=1 !ORIGIN : TOP 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 !' 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(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(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 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(GSCME,7,WHITE) !SET_COLOR_MAP_ENTRY. CALL CGL(GSWI,7) !SET_WRITING_INDEX. CALL CGL(GMA2,WXM,WYM) !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(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,//)','APFEL2 : See YOU later !' C CALL EXIT C END