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