home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MANDEL.ZIP / MANDELB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-05  |  4.8 KB  |  179 lines
  1. Program Mandelbrot;
  2. {$U-}
  3.  
  4. type
  5.     Special = String[23];
  6.  
  7.   chunk = record
  8.             Val1:Special;
  9.             Val2:Special;
  10.             Val3:Special;
  11.             Val4:Special;
  12.             littlechunk : array[0..319,0..199] of byte;
  13.           end;
  14.  
  15. Const
  16.  
  17. Beep :Char = ^G;
  18.  
  19. var
  20.  
  21. XPic,YPic,Color                         :Integer;
  22. RealUpper,RealLower,ImagUpper,ImagLower :Real;
  23. Name                                    :string[20];
  24. N                                       : byte;
  25. chunkfile                               :  file of chunk;
  26. ChunkRec                                :  Chunk;
  27. c,choice                                : char;
  28.  
  29. Procedure Generate;
  30.  
  31. var
  32.  
  33. RealPart,Imaginary,ZR,ZI,StepX,StepY,ZrSquared,ZISquared :Real;
  34.  
  35. Begin
  36.  
  37. Writeln('Enter Lower and upper limits of Real & Imaginary parts');
  38. Writeln('as:RL,RU,IL,IU each followed by a CR.');
  39. Readln(RealLower);
  40. Readln(RealUpper);
  41. Readln(ImagLower);
  42. readln(ImagUpper);
  43. Writeln('Enter filename:');
  44. Readln(Name);
  45. GraphColorMode;
  46. StepX:=(RealUpper-RealLower)/320.0;
  47. StepY:=(ImagUpper-ImagLower)/200.0;
  48. For Xpic := 0 to 319 do
  49.   Begin
  50.   For Ypic := 0 to 199 do
  51.     Begin
  52.     N:=0;
  53.     ZR:=0;
  54.     ZI:=0;
  55.     Plot(XPic-1,YPic-1,3);
  56.     RealPart:=RealLower+Int(Xpic)*Stepx;
  57.     Imaginary:=ImagLower+Int(Ypic)*StepY;
  58.     ZrSquared:=0;
  59.     ZISquared:=0;
  60.     repeat
  61.       ZI:=ZI*ZR*2+imaginary;
  62.       Zr:=ZrSquared+REALPart-ZISquared;
  63.       N:=N+1;
  64.       ZrSquared:=Sqr(Zr);
  65.       ZISquared:=Sqr(ZI);
  66.     Until ((ZrSquared+ZISquared)>4) or (N>254);
  67.     Color:=3-(N shr 6);  {make 0 to 255 into 15 to 0 for graphing}
  68.     Plot(XPic-1,Ypic-1,Color);
  69.     ChunkRec.LittleChunk[xpic,ypic]:=n;
  70.     End;
  71.     if keypressed then
  72.     Begin
  73.       Read(Kbd,c);
  74.       if c = Chr(3) then halt;
  75.     end;
  76.   End;
  77.   Write(beep);                         {Beep at finish}
  78.   Write(beep);                         {Beep at finish}
  79.   Write(beep);                         {Beep at finish}
  80.   Write(beep);                         {Beep at finish}
  81.   Write(beep);                         {Beep at finish}
  82.   Write(beep);                         {Beep at finish}
  83.   Write(beep);                         {Beep at finish}
  84.   Write(beep);                         {Beep at finish}
  85.   Write(beep);                         {Beep at finish}
  86.   Write(beep);                         {Beep at finish}
  87.   Write(beep);                         {Beep at finish}
  88.   Write(beep);                         {Beep at finish}
  89.   Read(Kbd,c);
  90.   TextMode;
  91. Str(RealLower:23,ChunkRec.Val1);
  92. Str(RealUpper:23,ChunkRec.Val2);
  93. Str(ImagLower:23,ChunkRec.Val3);
  94. Str(ImagUpper:23,ChunkRec.Val4);
  95. Assign(chunkfile,Name);
  96. Rewrite(chunkfile);
  97. Write(chunkfile,ChunkRec);
  98. Close(chunkfile);
  99. Write(beep);
  100. End;
  101.  
  102. Procedure Print;
  103.  
  104. var
  105.  
  106. RealUpper,RealLower,ImagUpper,ImagLower       :Real;
  107. N                                             :Byte;
  108. z                                             :String[10];
  109. Breakpoint1,Breakpoint2,EPosition,Palet,error :Integer;
  110.  
  111. Function Value(numstring:  Special) : Real;
  112.  
  113. var
  114. temporary : real;
  115.  
  116.   Begin
  117.     If Numstring[21]='0' then delete(numstring,21,1); {If written by 8087 version}
  118.     Repeat
  119.       Delete(numstring,1,1);
  120.     until Ord(NumString[1])<>32;    {delete spaces}
  121.     Val(NumString,temporary,error);
  122.     Value := temporary;
  123.     End;
  124.  
  125. Begin
  126.   Writeln('Enter Filename for data');
  127.   Readln(Name);
  128.   Assign(Chunkfile,Name);
  129.   Reset(Chunkfile);
  130.   Read(Chunkfile,ChunkRec);
  131.   Close(ChunkFile);
  132.   RealLower:=Value(ChunkRec.Val1);
  133.   RealUpper:=Value(ChunkRec.Val2);
  134.   ImagLower:=Value(ChunkRec.Val3);
  135.   ImagUpper:=Value(ChunkRec.Val4);
  136.   Writeln('Real Boundries are:  ',RealLower:10:8,'  ',RealUpper:10:8);
  137.   WriteLn('Imaginary Boundries: ',ImagLower:10:8,'  ',ImagUpper:10:8);
  138.   Writeln('255 will be black, Enter breakpoints for other two shades');
  139.   Readln(Breakpoint1);
  140.   Readln(Breakpoint2);
  141.   Writeln('When display is complete enter a "P" to change palettes or');
  142.   Writeln('any other character to exit.  Enter return to display plot');
  143.   Read(z);
  144.   GraphcolorMode;
  145.   For Xpic := 0 to 319 do
  146.   Begin
  147.     For Ypic := 0 to 199 do
  148.     Begin
  149.       N:=ChunkRec.LittleChunk[xpic,ypic];
  150.       If N=255 then Color := 0
  151.         else
  152.         If N<Breakpoint1 then Color := 3
  153.           else
  154.           If  (N<Breakpoint2) then Color := 2
  155.             else Color := 1;
  156.     Plot(XPic,Ypic,Color);
  157.    End;
  158.   End;
  159.   Palet := 0;
  160.   repeat
  161.   read(kbd,c); {wait for an entry before erasing screen}
  162.   Palet := (Palet+1) AND 3;
  163.   If UpCase(c) = 'P' then Palette(Palet);
  164.   Until Upcase(c) <> 'P';
  165.   textmode;
  166. End;
  167.  
  168. Begin
  169. Repeat
  170.   ClrScr;
  171.   Write('(C)reate a Mandelbrot file, (D)isplay a file or (E)xit ? ');
  172.   Repeat Read(kbd,choice) until UpCase(choice) in['C','D','E'];
  173.   Writeln;
  174.   Case Choice of
  175.     'c','C'   :Generate;
  176.     'd','D'   :Print;
  177.   end;
  178. until UpCase(choice) = 'E';
  179. end.