home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MNDLBROT.ZIP / MNDLBR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-02-19  |  7.5 KB  |  240 lines
  1. {                        MANDELBROT
  2. [Downloaded from Delaware OPUS 17 Feb 87 as MNDLBR.PAS.
  3.  Toad Hall
  4. ]
  5. This program generates and displays Mandelbrots.  A Mandelbrot is a
  6. graphic representation of the mandelbrot set and the fleeing points
  7. around the set on the REAL/IMAGINARY plane.  Mathmatically, a point
  8. in the set is defined as a point which when iterated in the following
  9. manner will remain finite after an infinite number of iterations:
  10.  
  11.               1. c := point; z := 0; n := 0;
  12.               2. z := z*z + c;
  13.               3  n := n+1;
  14.               4. repeat until either z>2 or n is some large number
  15.  
  16. Obviously the iteration cannot be carried out to infinity so we set an
  17. upper limit to 255.  Thus "n" can just fit in one byte.  Typically large
  18. computers will only carry n to 1000, and there is very little difference
  19. between 255 and 1000 iterations.
  20.  
  21. The Mandelbrot set representation is a breathtakingly beautiful thing.  You
  22. are encouraged to try and find an issue of August 1985 Scientific American
  23. for some really fantastic photos, as well as a well written article.
  24.  
  25. To operate the program just answer the questions.  A "C" will allow you
  26. to generate a mandelbrot and a "D" will allow you to display it with different
  27. "Breakpoints".  The IBM can only display 4 colors and 255 is defined as black.
  28.  
  29. You must enter 2 breakpoints: a lower and an upper.
  30. When n is between 0 and the lower breakpoint, color 1 will be displayed;
  31.           between breakpoint 1 and 2,         color 2 will be displayed;
  32.           and when between 2 and 255,         the third color is displayed.
  33.  
  34. Generating a file will usually require from 6 to  12 hours, or if an 8087
  35. chip is used (and Turbo 8087 is used for compiling)  the time is cut to
  36. "only" 2 to 4 hours.
  37.  
  38. It is recommended that the full Mandelbrot be computed first
  39. (RL,RU,IL,IU = -2,.5,-1.25,1.25), then blowups done from it.
  40. Remember to enter a carriage return after each number.
  41.  
  42. A disk for the IBM and compatibles which has this program and about 6 of the
  43. really good plots on it is available for $5 to cover the cost of the disk and
  44. shipping.
  45.  
  46. A disk with an advanced version of this program which allows windowing
  47. of an area in the display, so referencing is done automatically to
  48. the generate portion for an easy magnification of a specific area,
  49. is available for $15.
  50.  
  51. The advanced version will have standard as well as 8087 com files
  52. and includes many more features, as well as color pictures of several
  53. Mandelbrots and updates when new features are added.
  54.  
  55. To order or report bugs Reply to:   Marshall Dudley      or Compuserve
  56.                                     12402 W. Kingsgate Dr.  #72416,3357
  57.                                     Knoxville, Tn. 37922
  58.  
  59. This program may be duplicated and given away free provided
  60. this introduction is left untouched.
  61.  
  62. Modifications:  You may wish to try some modifications to this program.
  63. If this program is modified please indicate who and what mods were done below.
  64. I would be interested in hearing about any good mods and can be reached as
  65. above.
  66.  
  67. Please do not change the file structure.  It was done in this manner so that
  68. a file can be created and displayed by standard or 8087 turbo interchangeably.
  69. A change will cause compatibility problems.
  70.  
  71. }
  72.  
  73. PROGRAM Mandelbrot;
  74. {$U-}
  75.  
  76. TYPE
  77.     Special = STRING[23];
  78.  
  79.   chunk = RECORD
  80.             Val1:Special;
  81.             Val2:Special;
  82.             Val3:Special;
  83.             Val4:Special;
  84.             littlechunk : ARRAY[0..319,0..199] OF Byte;
  85.           END;
  86.  
  87. CONST
  88.  
  89. Beep :CHAR = ^G;
  90.  
  91. VAR
  92.  
  93. XPic,YPic,Color                         :INTEGER;
  94. RealUpper,RealLower,ImagUpper,ImagLower :REAL;
  95. Name                                    :STRING[20];
  96. N                                       : Byte;
  97. chunkfile                               :  FILE OF chunk;
  98. ChunkRec                                :  Chunk;
  99. c,choice                                : CHAR;
  100.  
  101. PROCEDURE Generate;
  102.  
  103. VAR
  104.  
  105. RealPart,Imaginary,ZR,ZI,StepX,StepY,ZrSquared,ZISquared :REAL;
  106.  
  107. BEGIN
  108.  
  109. WRITELN('Enter Lower and upper limits of Real & Imaginary parts');
  110. WRITELN('as:RL,RU,IL,IU each followed by a CR.');
  111. READLN(RealLower);
  112. READLN(RealUpper);
  113. READLN(ImagLower);
  114. READLN(ImagUpper);
  115. WRITELN('Enter filename:');
  116. READLN(Name);
  117. GraphColorMode;
  118. StepX:=(RealUpper-RealLower)/320.0;
  119. StepY:=(ImagUpper-ImagLower)/200.0;
  120. FOR Xpic := 0 TO 319 DO
  121.   BEGIN
  122.   FOR Ypic := 0 TO 199 DO
  123.     BEGIN
  124.     N:=0;
  125.     ZR:=0;
  126.     ZI:=0;
  127.     Plot(XPic-1,YPic-1,3);
  128.     RealPart:=RealLower+INT(Xpic)*Stepx;
  129.     Imaginary:=ImagLower+INT(Ypic)*StepY;
  130.     ZrSquared:=0;
  131.     ZISquared:=0;
  132.     REPEAT
  133.       ZI:=ZI*ZR*2+imaginary;
  134.       Zr:=ZrSquared+REALPart-ZISquared;
  135.       N:=N+1;
  136.       ZrSquared:=SQR(Zr);
  137.       ZISquared:=SQR(ZI);
  138.     UNTIL ((ZrSquared+ZISquared)>4) OR (N>254);
  139.     Color:=3-(N ShR 6);  {make 0 to 255 into 15 to 0 for graphing}
  140.     Plot(XPic-1,Ypic-1,Color);
  141.     ChunkRec.LittleChunk[xpic,ypic]:=n;
  142.     END;
  143.     IF KeyPressed THEN
  144.     BEGIN
  145.       READ(Kbd,c);
  146.       IF c = CHR(3) THEN HALT;
  147.     END;
  148.   END;
  149.   TextMode;
  150. WRITE(beep);                         {Beep at finish}
  151. STR(RealLower:23,ChunkRec.Val1);
  152. STR(RealUpper:23,ChunkRec.Val2);
  153. STR(ImagLower:23,ChunkRec.Val3);
  154. STR(ImagUpper:23,ChunkRec.Val4);
  155. Assign(chunkfile,Name);
  156. REWRITE(chunkfile);
  157. WRITE(chunkfile,ChunkRec);
  158. CLOSE(chunkfile);
  159. WRITE(beep);
  160. END;
  161.  
  162. PROCEDURE Print;
  163.  
  164. VAR
  165.  
  166. RealUpper,RealLower,ImagUpper,ImagLower       :REAL;
  167. N                                             :Byte;
  168. z                                             :STRING[10];
  169. Breakpoint1,Breakpoint2,EPosition,Palet,error :INTEGER;
  170.  
  171. FUNCTION Value(numstring:  Special) : REAL;
  172.  
  173. VAR
  174. temporary : REAL;
  175.  
  176.   BEGIN
  177.     IF Numstring[21]='0' THEN DELETE(numstring,21,1); {If written by 8087 version}
  178.     REPEAT
  179.       DELETE(numstring,1,1);
  180.     UNTIL ORD(NumString[1])<>32;    {delete spaces}
  181.     VAL(NumString,temporary,error);
  182.     Value := temporary;
  183.     END;
  184.  
  185. BEGIN
  186.   WRITELN('Enter Filename for data');
  187.   READLN(Name);
  188.   Assign(Chunkfile,Name);
  189.   RESET(Chunkfile);
  190.   READ(Chunkfile,ChunkRec);
  191.   CLOSE(ChunkFile);
  192.   RealLower:=Value(ChunkRec.Val1);
  193.   RealUpper:=Value(ChunkRec.Val2);
  194.   ImagLower:=Value(ChunkRec.Val3);
  195.   ImagUpper:=Value(ChunkRec.Val4);
  196.   WRITELN('Real Boundries are:  ',RealLower:10:8,'  ',RealUpper:10:8);
  197.   WRITELN('Imaginary Boundries: ',ImagLower:10:8,'  ',ImagUpper:10:8);
  198.   WRITELN('255 will be black, Enter breakpoints for other two shades');
  199.   READLN(Breakpoint1);
  200.   READLN(Breakpoint2);
  201.   WRITELN('When display is complete enter a "P" to change palettes or');
  202.   WRITELN('any other character to exit.  Enter return to display plot');
  203.   READ(z);
  204.   GraphColorMode;
  205.   FOR Xpic := 0 TO 319 DO
  206.   BEGIN
  207.     FOR Ypic := 0 TO 199 DO
  208.     BEGIN
  209.       N:=ChunkRec.LittleChunk[xpic,ypic];
  210.       IF N=255 THEN Color := 0
  211.         ELSE
  212.         IF N<Breakpoint1 THEN Color := 3
  213.           ELSE
  214.           IF  (N<Breakpoint2) THEN Color := 2
  215.             ELSE Color := 1;
  216.     Plot(XPic,Ypic,Color);
  217.    END;
  218.   END;
  219.   Palet := 0;
  220.   REPEAT
  221.   READ(Kbd,c); {wait for an entry before erasing screen}
  222.   Palet := (Palet+1) AND 3;
  223.   IF UpCase(c) = 'P' THEN Palette(Palet);
  224.   UNTIL UpCase(c) <> 'P';
  225.   TextMode;
  226. END;
  227.  
  228. BEGIN
  229. REPEAT
  230.   ClrScr;
  231.   WRITE('(C)reate a Mandelbrot file, (D)isplay a file or (E)xit ? ');
  232.   REPEAT READ(Kbd,choice) UNTIL UpCase(choice) IN['C','D','E'];
  233.   WRITELN;
  234.   CASE Choice OF
  235.     'c','C'   :Generate;
  236.     'd','D'   :Print;
  237.   END;
  238. UNTIL UpCase(choice) = 'E';
  239. END.
  240.